home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / pp_sys.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-10-20  |  74.6 KB  |  4,087 lines  |  [TEXT/MPS ]
  1. /*    pp_sys.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * But only a short way ahead its floor and the walls on either side were
  12.  * cloven by a great fissure, out of which the red glare came, now leaping
  13.  * up, now dying down into darkness; and all the while far below there was
  14.  * a rumour and a trouble as of great engines throbbing and labouring.
  15.  */
  16.  
  17. #include "EXTERN.h"
  18. #include "perl.h"
  19.  
  20. /* XXX Omit this -- it causes too much grief on mixed systems.
  21.    Next time, I should force broken systems to unset i_unistd in
  22.    hint files.
  23. */
  24. #if 0
  25. # ifdef I_UNISTD
  26. #  include <unistd.h>
  27. # endif
  28. #endif
  29.  
  30. /* Put this after #includes because fork and vfork prototypes may
  31.    conflict.
  32. */
  33. #ifndef HAS_VFORK
  34. #   define vfork fork
  35. #endif
  36.  
  37. #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
  38. # include <sys/socket.h>
  39. # include <netdb.h>
  40. # ifndef ENOTSOCK
  41. #  ifdef I_NET_ERRNO
  42. #   include <net/errno.h>
  43. #  endif
  44. # endif
  45. #endif
  46.  
  47. #ifdef HAS_SELECT
  48. #ifdef I_SYS_SELECT
  49. #ifndef I_SYS_TIME
  50. #include <sys/select.h>
  51. #endif
  52. #endif
  53. #endif
  54.  
  55. #ifdef HOST_NOT_FOUND
  56. extern int h_errno;
  57. #endif
  58.  
  59. #ifdef HAS_PASSWD
  60. # ifdef I_PWD
  61. #  include <pwd.h>
  62. # else
  63.     struct passwd *getpwnam _((char *));
  64.     struct passwd *getpwuid _((Uid_t));
  65. # endif
  66.   struct passwd *getpwent _((void));
  67. #endif
  68.  
  69. #ifdef HAS_GROUP
  70. # ifdef I_GRP
  71. #  include <grp.h>
  72. # else
  73.     struct group *getgrnam _((char *));
  74.     struct group *getgrgid _((Gid_t));
  75. # endif
  76.     struct group *getgrent _((void));
  77. #endif
  78.  
  79. #ifdef I_UTIME
  80. #include <utime.h>
  81. #endif
  82. #ifdef I_FCNTL
  83. #include <fcntl.h>
  84. #endif
  85. #ifdef I_SYS_FILE
  86. #include <sys/file.h>
  87. #endif
  88.  
  89. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  90. static int dooneliner _((char *cmd, char *filename));
  91. #endif
  92. /* Pushy I/O. */
  93.  
  94. PP(pp_backtick)
  95. {
  96.     dSP; dTARGET;
  97.     FILE *fp;
  98.     char *tmps = POPp;
  99.     TAINT_PROPER("``");
  100.     fp = my_popen(tmps, "r");
  101.     if (fp) {
  102.     sv_setpv(TARG, "");    /* note that this preserves previous buffer */
  103.     if (GIMME == G_SCALAR) {
  104.         while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
  105.         /*SUPPRESS 530*/
  106.         ;
  107.         XPUSHs(TARG);
  108.     }
  109.     else {
  110.         SV *sv;
  111.  
  112.         for (;;) {
  113.         sv = NEWSV(56, 80);
  114.         if (sv_gets(sv, fp, 0) == Nullch) {
  115.             SvREFCNT_dec(sv);
  116.             break;
  117.         }
  118.         XPUSHs(sv_2mortal(sv));
  119.         if (SvLEN(sv) - SvCUR(sv) > 20) {
  120.             SvLEN_set(sv, SvCUR(sv)+1);
  121.             Renew(SvPVX(sv), SvLEN(sv), char);
  122.         }
  123.         }
  124.     }
  125.     statusvalue = FIXSTATUS(my_pclose(fp));
  126.     }
  127.     else {
  128.     statusvalue = -1;
  129.     if (GIMME == G_SCALAR)
  130.         RETPUSHUNDEF;
  131.     }
  132.  
  133.     RETURN;
  134. }
  135.  
  136. PP(pp_glob)
  137. {
  138.     OP *result;
  139.     ENTER;
  140.  
  141.     SAVESPTR(last_in_gv);    /* We don't want this to be permanent. */
  142.     last_in_gv = (GV*)*stack_sp--;
  143.  
  144.     SAVESPTR(rs);        /* This is not permanent, either. */
  145.     rs = sv_2mortal(newSVpv("", 1));
  146. #ifndef DOSISH
  147. #ifndef CSH
  148.     *SvPVX(rs) = '\n';
  149. #endif    /* !CSH */
  150. #endif    /* !MSDOS */
  151.  
  152.     result = do_readline();
  153.     LEAVE;
  154.     return result;
  155. }
  156.  
  157. PP(pp_indread)
  158. {
  159.     last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
  160.     return do_readline();
  161. }
  162.  
  163. PP(pp_rcatline)
  164. {
  165.     last_in_gv = cGVOP->op_gv;
  166.     return do_readline();
  167. }
  168.  
  169. PP(pp_warn)
  170. {
  171.     dSP; dMARK;
  172.     char *tmps;
  173.     if (SP - MARK != 1) {
  174.     dTARGET;
  175.     do_join(TARG, &sv_no, MARK, SP);
  176.     tmps = SvPV(TARG, na);
  177.     SP = MARK + 1;
  178.     }
  179.     else {
  180.     tmps = SvPV(TOPs, na);
  181.     }
  182.     if (!tmps || !*tmps) {
  183.     SV *error = GvSV(errgv);
  184.     (void)SvUPGRADE(error, SVt_PV);
  185.     if (SvPOK(error) && SvCUR(error))
  186.         sv_catpv(error, "\t...caught");
  187.     tmps = SvPV(error, na);
  188.     }
  189.     if (!tmps || !*tmps)
  190.     tmps = "Warning: something's wrong";
  191.     warn("%s", tmps);
  192.     RETSETYES;
  193. }
  194.  
  195. PP(pp_die)
  196. {
  197.     dSP; dMARK;
  198.     char *tmps;
  199.     if (SP - MARK != 1) {
  200.     dTARGET;
  201.     do_join(TARG, &sv_no, MARK, SP);
  202.     tmps = SvPV(TARG, na);
  203.     SP = MARK + 1;
  204.     }
  205.     else {
  206.     tmps = SvPV(TOPs, na);
  207.     }
  208.     if (!tmps || !*tmps) {
  209.     SV *error = GvSV(errgv);
  210.     (void)SvUPGRADE(error, SVt_PV);
  211.     if (SvPOK(error) && SvCUR(error))
  212.         sv_catpv(error, "\t...propagated");
  213.     tmps = SvPV(error, na);
  214.     }
  215.     if (!tmps || !*tmps)
  216.     tmps = "Died";
  217.     DIE("%s", tmps);
  218. }
  219.  
  220. /* I/O. */
  221.  
  222. PP(pp_open)
  223. {
  224.     dSP; dTARGET;
  225.     GV *gv;
  226.     SV *sv;
  227.     char *tmps;
  228.     STRLEN len;
  229.  
  230.     if (MAXARG > 1)
  231.     sv = POPs;
  232.     else if (SvTYPE(TOPs) == SVt_PVGV)
  233.     sv = GvSV(TOPs);
  234.     else
  235.     DIE(no_usym, "filehandle");
  236.     gv = (GV*)POPs;
  237.     tmps = SvPV(sv, len);
  238.     if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp)) {
  239.     IoLINES(GvIOp(gv)) = 0;
  240.     PUSHi( (I32)forkprocess );
  241.     }
  242.     else if (forkprocess == 0)        /* we are a new child */
  243.     PUSHi(0);
  244.     else
  245.     RETPUSHUNDEF;
  246.     RETURN;
  247. }
  248.  
  249. PP(pp_close)
  250. {
  251.     dSP;
  252.     GV *gv;
  253.  
  254.     if (MAXARG == 0)
  255.     gv = defoutgv;
  256.     else
  257.     gv = (GV*)POPs;
  258.     EXTEND(SP, 1);
  259.     PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
  260.     RETURN;
  261. }
  262.  
  263. PP(pp_pipe_op)
  264. {
  265.     dSP;
  266. #ifdef HAS_PIPE
  267.     GV *rgv;
  268.     GV *wgv;
  269.     register IO *rstio;
  270.     register IO *wstio;
  271.     int fd[2];
  272.  
  273.     wgv = (GV*)POPs;
  274.     rgv = (GV*)POPs;
  275.  
  276.     if (!rgv || !wgv)
  277.     goto badexit;
  278.  
  279.     if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
  280.     DIE(no_usym, "filehandle");
  281.     rstio = GvIOn(rgv);
  282.     wstio = GvIOn(wgv);
  283.  
  284.     if (IoIFP(rstio))
  285.     do_close(rgv, FALSE);
  286.     if (IoIFP(wstio))
  287.     do_close(wgv, FALSE);
  288.  
  289.     if (pipe(fd) < 0)
  290.     goto badexit;
  291.  
  292.     IoIFP(rstio) = fdopen(fd[0], "r");
  293.     IoOFP(wstio) = fdopen(fd[1], "w");
  294.     IoIFP(wstio) = IoOFP(wstio);
  295.     IoTYPE(rstio) = '<';
  296.     IoTYPE(wstio) = '>';
  297.  
  298.     if (!IoIFP(rstio) || !IoOFP(wstio)) {
  299.     if (IoIFP(rstio)) fclose(IoIFP(rstio));
  300.     else close(fd[0]);
  301.     if (IoOFP(wstio)) fclose(IoOFP(wstio));
  302.     else close(fd[1]);
  303.     goto badexit;
  304.     }
  305.  
  306.     RETPUSHYES;
  307.  
  308. badexit:
  309.     RETPUSHUNDEF;
  310. #else
  311.     DIE(no_func, "pipe");
  312. #endif
  313. }
  314.  
  315. PP(pp_fileno)
  316. {
  317.     dSP; dTARGET;
  318.     GV *gv;
  319.     IO *io;
  320.     FILE *fp;
  321.     if (MAXARG < 1)
  322.     RETPUSHUNDEF;
  323.     gv = (GV*)POPs;
  324.     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
  325.     RETPUSHUNDEF;
  326.     PUSHi(fileno(fp));
  327.     RETURN;
  328. }
  329.  
  330. PP(pp_umask)
  331. {
  332.     dSP; dTARGET;
  333.     int anum;
  334.  
  335. #ifdef HAS_UMASK
  336.     if (MAXARG < 1) {
  337.     anum = umask(0);
  338.     (void)umask(anum);
  339.     }
  340.     else
  341.     anum = umask(POPi);
  342.     TAINT_PROPER("umask");
  343.     XPUSHi(anum);
  344. #else
  345.     DIE(no_func, "Unsupported function umask");
  346. #endif
  347.     RETURN;
  348. }
  349.  
  350. PP(pp_binmode)
  351. {
  352.     dSP;
  353.     GV *gv;
  354.     IO *io;
  355.     FILE *fp;
  356.  
  357.     if (MAXARG < 1)
  358.     RETPUSHUNDEF;
  359.  
  360.     gv = (GV*)POPs;
  361.  
  362.     EXTEND(SP, 1);
  363.     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
  364.     RETSETUNDEF;
  365.  
  366. #ifdef DOSISH
  367. #ifdef atarist
  368.     if (!Fflush(fp) && (fp->_flag |= _IOBIN))
  369.     RETPUSHYES;
  370.     else
  371.     RETPUSHUNDEF;
  372. #else
  373.     if (setmode(fileno(fp), OP_BINARY) != -1)
  374.     RETPUSHYES;
  375.     else
  376.     RETPUSHUNDEF;
  377. #endif
  378. #else
  379.     RETPUSHYES;
  380. #endif
  381. }
  382.  
  383. PP(pp_tie)
  384. {
  385.     dSP;
  386.     SV *varsv;
  387.     HV* stash;
  388.     GV *gv;
  389.     BINOP myop;
  390.     SV *sv;
  391.     SV **mark = stack_base + ++*markstack_ptr;    /* reuse in entersub */
  392.     I32 markoff = mark - stack_base - 1;
  393.     char *methname;
  394.  
  395.     varsv = mark[0];
  396.     if (SvTYPE(varsv) == SVt_PVHV)
  397.     methname = "TIEHASH";
  398.     else if (SvTYPE(varsv) == SVt_PVAV)
  399.     methname = "TIEARRAY";
  400.     else if (SvTYPE(varsv) == SVt_PVGV)
  401.     methname = "TIEHANDLE";
  402.     else
  403.     methname = "TIESCALAR";
  404.  
  405.     stash = gv_stashsv(mark[1], FALSE);
  406.     if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
  407.     DIE("Can't locate object method \"%s\" via package \"%s\"",
  408.         methname, SvPV(mark[1],na));
  409.  
  410.     Zero(&myop, 1, BINOP);
  411.     myop.op_last = (OP *) &myop;
  412.     myop.op_next = Nullop;
  413.     myop.op_flags = OPf_KNOW|OPf_STACKED;
  414.  
  415.     ENTER;
  416.     SAVESPTR(op);
  417.     op = (OP *) &myop;
  418.  
  419.     XPUSHs(gv);
  420.     PUTBACK;
  421.  
  422.     if (op = pp_entersub())
  423.         runops();
  424.     SPAGAIN;
  425.  
  426.     sv = TOPs;
  427.     if (sv_isobject(sv)) {
  428.     if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
  429.         sv_unmagic(varsv, 'P');
  430.         sv_magic(varsv, sv, 'P', Nullch, 0);
  431.     }
  432.     else {
  433.         sv_unmagic(varsv, 'q');
  434.         sv_magic(varsv, sv, 'q', Nullch, 0);
  435.     }
  436.     }
  437.     LEAVE;
  438.     SP = stack_base + markoff;
  439.     PUSHs(sv);
  440.     RETURN;
  441. }
  442.  
  443. PP(pp_untie)
  444. {
  445.     dSP;
  446.     if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV)
  447.     sv_unmagic(TOPs, 'P');
  448.     else
  449.     sv_unmagic(TOPs, 'q');
  450.     RETSETYES;
  451. }
  452.  
  453. PP(pp_tied)
  454. {
  455.     dSP;
  456.     SV * sv ;
  457.     MAGIC * mg ;
  458.  
  459.     sv = POPs;
  460.     if (SvMAGICAL(sv)) {
  461.         if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
  462.             mg = mg_find(sv, 'P') ;
  463.         else
  464.             mg = mg_find(sv, 'q') ;
  465.  
  466.         if (mg)  {
  467.             PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ; 
  468.             RETURN ;
  469.     }
  470.     }
  471.  
  472.     RETPUSHUNDEF;
  473. }
  474.  
  475. PP(pp_dbmopen)
  476. {
  477.     dSP;
  478.     HV *hv;
  479.     dPOPPOPssrl;
  480.     HV* stash;
  481.     GV *gv;
  482.     BINOP myop;
  483.     SV *sv;
  484.  
  485.     hv = (HV*)POPs;
  486.  
  487.     sv = sv_mortalcopy(&sv_no);
  488.     sv_setpv(sv, "AnyDBM_File");
  489.     stash = gv_stashsv(sv, FALSE);
  490.     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
  491.     PUTBACK;
  492.     perl_require_pv("AnyDBM_File.pm");
  493.     SPAGAIN;
  494.     if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
  495.         DIE("No dbm on this machine");
  496.     }
  497.  
  498.     Zero(&myop, 1, BINOP);
  499.     myop.op_last = (OP *) &myop;
  500.     myop.op_next = Nullop;
  501.     myop.op_flags = OPf_KNOW|OPf_STACKED;
  502.  
  503.     ENTER;
  504.     SAVESPTR(op);
  505.     op = (OP *) &myop;
  506.     PUTBACK;
  507.     pp_pushmark();
  508.  
  509.     EXTEND(sp, 5);
  510.     PUSHs(sv);
  511.     PUSHs(left);
  512.     if (SvIV(right))
  513.     PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
  514.     else
  515.     PUSHs(sv_2mortal(newSViv(O_RDWR)));
  516.     PUSHs(right);
  517.     PUSHs(gv);
  518.     PUTBACK;
  519.  
  520.     if (op = pp_entersub())
  521.         runops();
  522.     SPAGAIN;
  523.  
  524.     if (!sv_isobject(TOPs)) {
  525.     sp--;
  526.     op = (OP *) &myop;
  527.     PUTBACK;
  528.     pp_pushmark();
  529.  
  530.     PUSHs(sv);
  531.     PUSHs(left);
  532.     PUSHs(sv_2mortal(newSViv(O_RDONLY)));
  533.     PUSHs(right);
  534.     PUSHs(gv);
  535.     PUTBACK;
  536.  
  537.     if (op = pp_entersub())
  538.         runops();
  539.     SPAGAIN;
  540.     }
  541.  
  542.     if (sv_isobject(TOPs))
  543.     sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
  544.     LEAVE;
  545.     RETURN;
  546. }
  547.  
  548. PP(pp_dbmclose)
  549. {
  550.     return pp_untie(ARGS);
  551. }
  552.  
  553. PP(pp_sselect)
  554. {
  555.     dSP; dTARGET;
  556. #ifdef HAS_SELECT
  557.     register I32 i;
  558.     register I32 j;
  559.     register char *s;
  560.     register SV *sv;
  561.     double value;
  562.     I32 maxlen = 0;
  563.     I32 nfound;
  564.     struct timeval timebuf;
  565.     struct timeval *tbuf = &timebuf;
  566.     I32 growsize;
  567.     char *fd_sets[4];
  568. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  569.     I32 masksize;
  570.     I32 offset;
  571.     I32 k;
  572.  
  573. #   if BYTEORDER & 0xf0000
  574. #    define ORDERBYTE (0x88888888 - BYTEORDER)
  575. #   else
  576. #    define ORDERBYTE (0x4444 - BYTEORDER)
  577. #   endif
  578.  
  579. #endif
  580.  
  581.     SP -= 4;
  582.     for (i = 1; i <= 3; i++) {
  583.     if (!SvPOK(SP[i]))
  584.         continue;
  585.     j = SvCUR(SP[i]);
  586.     if (maxlen < j)
  587.         maxlen = j;
  588.     }
  589.  
  590. #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
  591. #ifdef __linux__
  592.     growsize = sizeof(fd_set);
  593. #else
  594.     growsize = maxlen;        /* little endians can use vecs directly */
  595. #endif
  596. #else
  597. #ifdef NFDBITS
  598.  
  599. #ifndef NBBY
  600. #define NBBY 8
  601. #endif
  602.  
  603.     masksize = NFDBITS / NBBY;
  604. #else
  605.     masksize = sizeof(long);    /* documented int, everyone seems to use long */
  606. #endif
  607.     growsize = maxlen + (masksize - (maxlen % masksize));
  608.     Zero(&fd_sets[0], 4, char*);
  609. #endif
  610.  
  611.     sv = SP[4];
  612.     if (SvOK(sv)) {
  613.     value = SvNV(sv);
  614.     if (value < 0.0)
  615.         value = 0.0;
  616.     timebuf.tv_sec = (long)value;
  617.     value -= (double)timebuf.tv_sec;
  618.     timebuf.tv_usec = (long)(value * 1000000.0);
  619.     }
  620.     else
  621.     tbuf = Null(struct timeval*);
  622.  
  623.     for (i = 1; i <= 3; i++) {
  624.     sv = SP[i];
  625.     if (!SvOK(sv)) {
  626.         fd_sets[i] = 0;
  627.         continue;
  628.     }
  629.     else if (!SvPOK(sv))
  630.         SvPV_force(sv,na);    /* force string conversion */
  631.     j = SvLEN(sv);
  632.     if (j < growsize) {
  633.         Sv_Grow(sv, growsize);
  634.     }
  635.     j = SvCUR(sv);
  636.     s = SvPVX(sv) + j;
  637.     while (++j <= growsize) {
  638.         *s++ = '\0';
  639.     }
  640.  
  641. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  642.     s = SvPVX(sv);
  643.     New(403, fd_sets[i], growsize, char);
  644.     for (offset = 0; offset < growsize; offset += masksize) {
  645.         for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
  646.         fd_sets[i][j+offset] = s[(k % masksize) + offset];
  647.     }
  648. #else
  649.     fd_sets[i] = SvPVX(sv);
  650. #endif
  651.     }
  652.  
  653.     nfound = select(
  654.     maxlen * 8,
  655.     (Select_fd_set_t) fd_sets[1],
  656.     (Select_fd_set_t) fd_sets[2],
  657.     (Select_fd_set_t) fd_sets[3],
  658.     tbuf);
  659.     for (i = 1; i <= 3; i++) {
  660.     if (fd_sets[i]) {
  661.         sv = SP[i];
  662. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  663.         s = SvPVX(sv);
  664.         for (offset = 0; offset < growsize; offset += masksize) {
  665.         for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
  666.             s[(k % masksize) + offset] = fd_sets[i][j+offset];
  667.         }
  668.         Safefree(fd_sets[i]);
  669. #endif
  670.         SvSETMAGIC(sv);
  671.     }
  672.     }
  673.  
  674.     PUSHi(nfound);
  675.     if (GIMME == G_ARRAY && tbuf) {
  676.     value = (double)(timebuf.tv_sec) +
  677.         (double)(timebuf.tv_usec) / 1000000.0;
  678.     PUSHs(sv = sv_mortalcopy(&sv_no));
  679.     sv_setnv(sv, value);
  680.     }
  681.     RETURN;
  682. #else
  683.     DIE("select not implemented");
  684. #endif
  685. }
  686.  
  687. void
  688. setdefout(gv)
  689. GV *gv;
  690. {
  691.     if (gv)
  692.     (void)SvREFCNT_inc(gv);
  693.     if (defoutgv)
  694.     SvREFCNT_dec(defoutgv);
  695.     defoutgv = gv;
  696. }
  697.  
  698. PP(pp_select)
  699. {
  700.     dSP; dTARGET;
  701.     GV *newdefout, *egv;
  702.     HV *hv;
  703.  
  704.     newdefout = (op->op_private > 0) ? ((GV *) POPs) : NULL;
  705.  
  706.     egv = GvEGV(defoutgv);
  707.     if (!egv)
  708.     egv = defoutgv;
  709.     hv = GvSTASH(egv);
  710.     if (! hv)
  711.     XPUSHs(&sv_undef);
  712.     else {
  713.     GV **gvp = hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
  714.     if (gvp && *gvp == egv)
  715.         gv_efullname(TARG, defoutgv);
  716.     else
  717.         sv_setsv(TARG, sv_2mortal(newRV(egv)));
  718.     XPUSHTARG;
  719.     }
  720.  
  721.     if (newdefout) {
  722.     if (!GvIO(newdefout))
  723.         gv_IOadd(newdefout);
  724.     setdefout(newdefout);
  725.     }
  726.  
  727.     RETURN;
  728. }
  729.  
  730. PP(pp_getc)
  731. {
  732.     dSP; dTARGET;
  733.     GV *gv;
  734.  
  735.     if (MAXARG <= 0)
  736.     gv = stdingv;
  737.     else
  738.     gv = (GV*)POPs;
  739.     if (!gv)
  740.     gv = argvgv;
  741.     if (!gv || do_eof(gv)) /* make sure we have fp with something */
  742.     RETPUSHUNDEF;
  743.     TAINT_IF(1);
  744.     sv_setpv(TARG, " ");
  745.     *SvPVX(TARG) = getc(IoIFP(GvIOp(gv))); /* should never be EOF */
  746.     PUSHTARG;
  747.     RETURN;
  748. }
  749.  
  750. PP(pp_read)
  751. {
  752.     return pp_sysread(ARGS);
  753. }
  754.  
  755. static OP *
  756. doform(cv,gv,retop)
  757. CV *cv;
  758. GV *gv;
  759. OP *retop;
  760. {
  761.     register CONTEXT *cx;
  762.     I32 gimme = GIMME;
  763.     AV* padlist = CvPADLIST(cv);
  764.     SV** svp = AvARRAY(padlist);
  765.  
  766.     ENTER;
  767.     SAVETMPS;
  768.  
  769.     push_return(retop);
  770.     PUSHBLOCK(cx, CXt_SUB, stack_sp);
  771.     PUSHFORMAT(cx);
  772.     SAVESPTR(curpad);
  773.     curpad = AvARRAY((AV*)svp[1]);
  774.  
  775.     setdefout(gv);        /* locally select filehandle so $% et al work */
  776.     return CvSTART(cv);
  777. }
  778.  
  779. PP(pp_enterwrite)
  780. {
  781.     dSP;
  782.     register GV *gv;
  783.     register IO *io;
  784.     GV *fgv;
  785.     CV *cv;
  786.  
  787.     if (MAXARG == 0)
  788.     gv = defoutgv;
  789.     else {
  790.     gv = (GV*)POPs;
  791.     if (!gv)
  792.         gv = defoutgv;
  793.     }
  794.     EXTEND(SP, 1);
  795.     io = GvIO(gv);
  796.     if (!io) {
  797.     RETPUSHNO;
  798.     }
  799.     if (IoFMT_GV(io))
  800.     fgv = IoFMT_GV(io);
  801.     else
  802.     fgv = gv;
  803.  
  804.     cv = GvFORM(fgv);
  805.  
  806.     if (!cv) {
  807.     if (fgv) {
  808.         SV *tmpsv = sv_newmortal();
  809.         gv_efullname(tmpsv, gv);
  810.         DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
  811.     }
  812.     DIE("Not a format reference");
  813.     }
  814.     IoFLAGS(io) &= ~IOf_DIDTOP;
  815.  
  816.     return doform(cv,gv,op->op_next);
  817. }
  818.  
  819. PP(pp_leavewrite)
  820. {
  821.     dSP;
  822.     GV *gv = cxstack[cxstack_ix].blk_sub.gv;
  823.     register IO *io = GvIOp(gv);
  824.     FILE *ofp = IoOFP(io);
  825.     FILE *fp;
  826.     SV **newsp;
  827.     I32 gimme;
  828.     register CONTEXT *cx;
  829.  
  830.     DEBUG_f(fprintf(Perl_debug_log,"left=%ld, todo=%ld\n",
  831.       (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
  832.     if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
  833.     formtarget != toptarget)
  834.     {
  835.     GV *fgv;
  836.     CV *cv;
  837.     if (!IoTOP_GV(io)) {
  838.         GV *topgv;
  839.         char tmpbuf[256];
  840.  
  841.         if (!IoTOP_NAME(io)) {
  842.         if (!IoFMT_NAME(io))
  843.             IoFMT_NAME(io) = savepv(GvNAME(gv));
  844.         sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
  845.         topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
  846.         if ((topgv && GvFORM(topgv)) ||
  847.           !gv_fetchpv("top",FALSE,SVt_PVFM))
  848.             IoTOP_NAME(io) = savepv(tmpbuf);
  849.         else
  850.             IoTOP_NAME(io) = savepv("top");
  851.         }
  852.         topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM);
  853.         if (!topgv || !GvFORM(topgv)) {
  854.         IoLINES_LEFT(io) = 100000000;
  855.         goto forget_top;
  856.         }
  857.         IoTOP_GV(io) = topgv;
  858.     }
  859.     if (IoFLAGS(io) & IOf_DIDTOP) {    /* Oh dear.  It still doesn't fit. */
  860.         I32 lines = IoLINES_LEFT(io);
  861.         char *s = SvPVX(formtarget);
  862.         if (lines <= 0)        /* Yow, header didn't even fit!!! */
  863.         goto forget_top;
  864.         while (lines-- > 0) {
  865.         s = strchr(s, '\n');
  866.         if (!s)
  867.             break;
  868.         s++;
  869.         }
  870.         if (s) {
  871.         fwrite1(SvPVX(formtarget), s - SvPVX(formtarget), 1, ofp);
  872.         sv_chop(formtarget, s);
  873.         FmLINES(formtarget) -= IoLINES_LEFT(io);
  874.         }
  875.     }
  876.     if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
  877.         fwrite1(SvPVX(formfeed), SvCUR(formfeed), 1, ofp);
  878.     IoLINES_LEFT(io) = IoPAGE_LEN(io);
  879.     IoPAGE(io)++;
  880.     formtarget = toptarget;
  881.     IoFLAGS(io) |= IOf_DIDTOP;
  882.     fgv = IoTOP_GV(io);
  883.     if (!fgv)
  884.         DIE("bad top format reference");
  885.     cv = GvFORM(fgv);
  886.     if (!cv) {
  887.         SV *tmpsv = sv_newmortal();
  888.         gv_efullname(tmpsv, fgv);
  889.         DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
  890.     }
  891.     return doform(cv,gv,op);
  892.     }
  893.  
  894.   forget_top:
  895.     POPBLOCK(cx,curpm);
  896.     POPFORMAT(cx);
  897.     LEAVE;
  898.  
  899.     fp = IoOFP(io);
  900.     if (!fp) {
  901.     if (dowarn) {
  902.         if (IoIFP(io))
  903.         warn("Filehandle only opened for input");
  904.         else
  905.         warn("Write on closed filehandle");
  906.     }
  907.     PUSHs(&sv_no);
  908.     }
  909.     else {
  910.     if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
  911.         if (dowarn)
  912.         warn("page overflow");
  913.     }
  914.     if (!fwrite1(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) ||
  915.         ferror(fp))
  916.         PUSHs(&sv_no);
  917.     else {
  918.         FmLINES(formtarget) = 0;
  919.         SvCUR_set(formtarget, 0);
  920.         *SvEND(formtarget) = '\0';
  921.         if (IoFLAGS(io) & IOf_FLUSH)
  922.         (void)Fflush(fp);
  923.         PUSHs(&sv_yes);
  924.     }
  925.     }
  926.     formtarget = bodytarget;
  927.     PUTBACK;
  928.     return pop_return();
  929. }
  930.  
  931. PP(pp_prtf)
  932. {
  933.     dSP; dMARK; dORIGMARK;
  934.     GV *gv;
  935.     IO *io;
  936.     FILE *fp;
  937.     SV *sv = NEWSV(0,0);
  938.  
  939.     if (op->op_flags & OPf_STACKED)
  940.     gv = (GV*)*++MARK;
  941.     else
  942.     gv = defoutgv;
  943.     if (!(io = GvIO(gv))) {
  944.     if (dowarn) {
  945.         gv_fullname(sv,gv);
  946.         warn("Filehandle %s never opened", SvPV(sv,na));
  947.     }
  948.     SETERRNO(EBADF,RMS$_IFI);
  949.     goto just_say_no;
  950.     }
  951.     else if (!(fp = IoOFP(io))) {
  952.     if (dowarn)  {
  953.         gv_fullname(sv,gv);
  954.         if (IoIFP(io))
  955.         warn("Filehandle %s opened only for input", SvPV(sv,na));
  956.         else
  957.         warn("printf on closed filehandle %s", SvPV(sv,na));
  958.     }
  959.     SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
  960.     goto just_say_no;
  961.     }
  962.     else {
  963.     do_sprintf(sv, SP - MARK, MARK + 1);
  964.     if (!do_print(sv, fp))
  965.         goto just_say_no;
  966.  
  967.     if (IoFLAGS(io) & IOf_FLUSH)
  968.         if (Fflush(fp) == EOF)
  969.         goto just_say_no;
  970.     }
  971.     SvREFCNT_dec(sv);
  972.     SP = ORIGMARK;
  973.     PUSHs(&sv_yes);
  974.     RETURN;
  975.  
  976.   just_say_no:
  977.     SvREFCNT_dec(sv);
  978.     SP = ORIGMARK;
  979.     PUSHs(&sv_undef);
  980.     RETURN;
  981. }
  982.  
  983. PP(pp_sysopen)
  984. {
  985.     dSP;
  986.     GV *gv;
  987.     SV *sv;
  988.     char *tmps;
  989.     STRLEN len;
  990.     int mode, perm;
  991.  
  992.     if (MAXARG > 3)
  993.     perm = POPi;
  994.     else
  995.     perm = 0666;
  996.     mode = POPi;
  997.     sv = POPs;
  998.     gv = (GV *)POPs;
  999.  
  1000.     tmps = SvPV(sv, len);
  1001.     if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
  1002.     IoLINES(GvIOp(gv)) = 0;
  1003.     PUSHs(&sv_yes);
  1004.     }
  1005.     else {
  1006.     PUSHs(&sv_undef);
  1007.     }
  1008.     RETURN;
  1009. }
  1010.  
  1011. PP(pp_sysread)
  1012. {
  1013.     dSP; dMARK; dORIGMARK; dTARGET;
  1014.     int offset;
  1015.     GV *gv;
  1016.     IO *io;
  1017.     char *buffer;
  1018.     int length;
  1019.     int bufsize;
  1020.     SV *bufsv;
  1021.     STRLEN blen;
  1022.  
  1023.     gv = (GV*)*++MARK;
  1024.     if (!gv)
  1025.     goto say_undef;
  1026.     bufsv = *++MARK;
  1027.     buffer = SvPV_force(bufsv, blen);
  1028.     length = SvIVx(*++MARK);
  1029.     if (length < 0)
  1030.     DIE("Negative length");
  1031.     SETERRNO(0,0);
  1032.     if (MARK < SP)
  1033.     offset = SvIVx(*++MARK);
  1034.     else
  1035.     offset = 0;
  1036.     io = GvIO(gv);
  1037.     if (!io || !IoIFP(io))
  1038.     goto say_undef;
  1039. #ifdef HAS_SOCKET
  1040.     if (op->op_type == OP_RECV) {
  1041.     bufsize = sizeof buf;
  1042.     buffer = SvGROW(bufsv, length+1);
  1043.     length = recvfrom(fileno(IoIFP(io)), buffer, length, offset,
  1044.         (struct sockaddr *)buf, &bufsize);
  1045.     if (length < 0)
  1046.         RETPUSHUNDEF;
  1047.     SvCUR_set(bufsv, length);
  1048.     *SvEND(bufsv) = '\0';
  1049.     (void)SvPOK_only(bufsv);
  1050.     SvSETMAGIC(bufsv);
  1051.     if (tainting)
  1052.         sv_magic(bufsv, Nullsv, 't', Nullch, 0);
  1053.     SP = ORIGMARK;
  1054.     sv_setpvn(TARG, buf, bufsize);
  1055.     PUSHs(TARG);
  1056.     RETURN;
  1057.     }
  1058. #else
  1059.     if (op->op_type == OP_RECV)
  1060.     DIE(no_sock_func, "recv");
  1061. #endif
  1062.     buffer = SvGROW(bufsv, length+offset+1);
  1063.     if (op->op_type == OP_SYSREAD) {
  1064.     length = read(fileno(IoIFP(io)), buffer+offset, length);
  1065.     }
  1066.     else
  1067. #ifdef HAS_SOCKET__bad_code_maybe
  1068.     if (IoTYPE(io) == 's') {
  1069.     bufsize = sizeof buf;
  1070.     length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0,
  1071.         (struct sockaddr *)buf, &bufsize);
  1072.     }
  1073.     else
  1074. #endif
  1075.     length = fread(buffer+offset, 1, length, IoIFP(io));
  1076.     if (length < 0)
  1077.     goto say_undef;
  1078.     SvCUR_set(bufsv, length+offset);
  1079.     *SvEND(bufsv) = '\0';
  1080.     (void)SvPOK_only(bufsv);
  1081.     SvSETMAGIC(bufsv);
  1082.     if (tainting)
  1083.     sv_magic(bufsv, Nullsv, 't', Nullch, 0);
  1084.     SP = ORIGMARK;
  1085.     PUSHi(length);
  1086.     RETURN;
  1087.  
  1088.   say_undef:
  1089.     SP = ORIGMARK;
  1090.     RETPUSHUNDEF;
  1091. }
  1092.  
  1093. PP(pp_syswrite)
  1094. {
  1095.     return pp_send(ARGS);
  1096. }
  1097.  
  1098. PP(pp_send)
  1099. {
  1100.     dSP; dMARK; dORIGMARK; dTARGET;
  1101.     GV *gv;
  1102.     IO *io;
  1103.     int offset;
  1104.     SV *bufsv;
  1105.     char *buffer;
  1106.     int length;
  1107.     STRLEN blen;
  1108.  
  1109.     gv = (GV*)*++MARK;
  1110.     if (!gv)
  1111.     goto say_undef;
  1112.     bufsv = *++MARK;
  1113.     buffer = SvPV(bufsv, blen);
  1114.     length = SvIVx(*++MARK);
  1115.     if (length < 0)
  1116.     DIE("Negative length");
  1117.     SETERRNO(0,0);
  1118.     io = GvIO(gv);
  1119.     if (!io || !IoIFP(io)) {
  1120.     length = -1;
  1121.     if (dowarn) {
  1122.         if (op->op_type == OP_SYSWRITE)
  1123.         warn("Syswrite on closed filehandle");
  1124.         else
  1125.         warn("Send on closed socket");
  1126.     }
  1127.     }
  1128.     else if (op->op_type == OP_SYSWRITE) {
  1129.     if (MARK < SP)
  1130.         offset = SvIVx(*++MARK);
  1131.     else
  1132.         offset = 0;
  1133.     if (length > blen - offset)
  1134.         length = blen - offset;
  1135.     length = write(fileno(IoIFP(io)), buffer+offset, length);
  1136.     }
  1137. #ifdef HAS_SOCKET
  1138.     else if (SP > MARK) {
  1139.     char *sockbuf;
  1140.     STRLEN mlen;
  1141.     sockbuf = SvPVx(*++MARK, mlen);
  1142.     length = sendto(fileno(IoIFP(io)), buffer, blen, length,
  1143.                 (struct sockaddr *)sockbuf, mlen);
  1144.     }
  1145.     else
  1146.     length = send(fileno(IoIFP(io)), buffer, blen, length);
  1147. #else
  1148.     else
  1149.     DIE(no_sock_func, "send");
  1150. #endif
  1151.     if (length < 0)
  1152.     goto say_undef;
  1153.     SP = ORIGMARK;
  1154.     PUSHi(length);
  1155.     RETURN;
  1156.  
  1157.   say_undef:
  1158.     SP = ORIGMARK;
  1159.     RETPUSHUNDEF;
  1160. }
  1161.  
  1162. PP(pp_recv)
  1163. {
  1164.     return pp_sysread(ARGS);
  1165. }
  1166.  
  1167. PP(pp_eof)
  1168. {
  1169.     dSP;
  1170.     GV *gv;
  1171.  
  1172.     if (MAXARG <= 0)
  1173.     gv = last_in_gv;
  1174.     else
  1175.     gv = last_in_gv = (GV*)POPs;
  1176.     PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no);
  1177.     RETURN;
  1178. }
  1179.  
  1180. PP(pp_tell)
  1181. {
  1182.     dSP; dTARGET;
  1183.     GV *gv;
  1184.  
  1185.     if (MAXARG <= 0)
  1186.     gv = last_in_gv;
  1187.     else
  1188.     gv = last_in_gv = (GV*)POPs;
  1189.     PUSHi( do_tell(gv) );
  1190.     RETURN;
  1191. }
  1192.  
  1193. PP(pp_seek)
  1194. {
  1195.     dSP;
  1196.     GV *gv;
  1197.     int whence = POPi;
  1198.     long offset = POPl;
  1199.  
  1200.     gv = last_in_gv = (GV*)POPs;
  1201.     PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no );
  1202.     RETURN;
  1203. }
  1204.  
  1205. PP(pp_truncate)
  1206. {
  1207.     dSP;
  1208.     Off_t len = (Off_t)POPn;
  1209.     int result = 1;
  1210.     GV *tmpgv;
  1211.  
  1212.     SETERRNO(0,0);
  1213. #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
  1214. #ifdef HAS_TRUNCATE
  1215.     if (op->op_flags & OPf_SPECIAL) {
  1216.     tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
  1217.     if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1218.       ftruncate(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
  1219.         result = 0;
  1220.     }
  1221.     else if (truncate(POPp, len) < 0)
  1222.     result = 0;
  1223. #else
  1224.     if (op->op_flags & OPf_SPECIAL) {
  1225.     tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
  1226.     if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1227.       chsize(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
  1228.         result = 0;
  1229.     }
  1230.     else {
  1231.     int tmpfd;
  1232.  
  1233.     if ((tmpfd = open(POPp, 0)) < 0)
  1234.         result = 0;
  1235.     else {
  1236.         if (chsize(tmpfd, len) < 0)
  1237.         result = 0;
  1238.         close(tmpfd);
  1239.     }
  1240.     }
  1241. #endif
  1242.  
  1243.     if (result)
  1244.     RETPUSHYES;
  1245.     if (!errno)
  1246.     SETERRNO(EBADF,RMS$_IFI);
  1247.     RETPUSHUNDEF;
  1248. #else
  1249.     DIE("truncate not implemented");
  1250. #endif
  1251. }
  1252.  
  1253. PP(pp_fcntl)
  1254. {
  1255.     return pp_ioctl(ARGS);
  1256. }
  1257.  
  1258. PP(pp_ioctl)
  1259. {
  1260.     dSP; dTARGET;
  1261.     SV *argsv = POPs;
  1262.     unsigned int func = U_I(POPn);
  1263.     int optype = op->op_type;
  1264.     char *s;
  1265.     int retval;
  1266.     GV *gv = (GV*)POPs;
  1267.     IO *io = GvIOn(gv);
  1268.  
  1269.     if (!io || !argsv || !IoIFP(io)) {
  1270.     SETERRNO(EBADF,RMS$_IFI);    /* well, sort of... */
  1271.     RETPUSHUNDEF;
  1272.     }
  1273.  
  1274.     if (SvPOK(argsv) || !SvNIOK(argsv)) {
  1275.     STRLEN len;
  1276.     s = SvPV_force(argsv, len);
  1277.     retval = IOCPARM_LEN(func);
  1278.     if (len < retval) {
  1279.         s = Sv_Grow(argsv, retval+1);
  1280.         SvCUR_set(argsv, retval);
  1281.     }
  1282.  
  1283.     s[SvCUR(argsv)] = 17;    /* a little sanity check here */
  1284.     }
  1285.     else {
  1286.     retval = SvIV(argsv);
  1287. #ifdef DOSISH
  1288.     s = (char*)(long)retval;    /* ouch */
  1289. #else
  1290.     s = (char*)retval;        /* ouch */
  1291. #endif
  1292.     }
  1293.  
  1294.     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
  1295.  
  1296.     if (optype == OP_IOCTL)
  1297. #ifdef HAS_IOCTL
  1298. #ifdef macintosh
  1299.     retval = ioctl(fileno(IoIFP(io)), func, (void *)s);
  1300. #else
  1301.     retval = ioctl(fileno(IoIFP(io)), func, s);
  1302. #endif
  1303. #else
  1304.     DIE("ioctl is not implemented");
  1305. #endif
  1306.     else
  1307. #if defined(DOSISH) && !defined(OS2)
  1308.     DIE("fcntl is not implemented");
  1309. #else
  1310. #   ifdef HAS_FCNTL
  1311. #     if (defined(OS2) && defined(__EMX__)) || defined(macintosh)
  1312.     retval = fcntl(fileno(IoIFP(io)), func, (int)s);
  1313. #     else
  1314.     retval = fcntl(fileno(IoIFP(io)), func, s);
  1315. #     endif 
  1316. #   else
  1317.     DIE("fcntl is not implemented");
  1318. #   endif
  1319. #endif
  1320.  
  1321.     if (SvPOK(argsv)) {
  1322.     if (s[SvCUR(argsv)] != 17)
  1323.         DIE("Possible memory corruption: %s overflowed 3rd argument",
  1324.         op_name[optype]);
  1325.     s[SvCUR(argsv)] = 0;        /* put our null back */
  1326.     SvSETMAGIC(argsv);        /* Assume it has changed */
  1327.     }
  1328.  
  1329.     if (retval == -1)
  1330.     RETPUSHUNDEF;
  1331.     if (retval != 0) {
  1332.     PUSHi(retval);
  1333.     }
  1334.     else {
  1335.     PUSHp("0 but true", 10);
  1336.     }
  1337.     RETURN;
  1338. }
  1339.  
  1340. PP(pp_flock)
  1341. {
  1342.     dSP; dTARGET;
  1343.     I32 value;
  1344.     int argtype;
  1345.     GV *gv;
  1346.     FILE *fp;
  1347.  
  1348. #if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
  1349. #  define flock lockf_emulate_flock
  1350. #endif
  1351.  
  1352. #if defined(HAS_FLOCK) || defined(flock)
  1353.     argtype = POPi;
  1354.     if (MAXARG <= 0)
  1355.     gv = last_in_gv;
  1356.     else
  1357.     gv = (GV*)POPs;
  1358.     if (gv && GvIO(gv))
  1359.     fp = IoIFP(GvIOp(gv));
  1360.     else
  1361.     fp = Nullfp;
  1362.     if (fp) {
  1363.     value = (I32)(flock(fileno(fp), argtype) >= 0);
  1364.     }
  1365.     else
  1366.     value = 0;
  1367.     PUSHi(value);
  1368.     RETURN;
  1369. #else
  1370.     DIE(no_func, "flock()");
  1371. #endif
  1372. }
  1373.  
  1374. /* Sockets. */
  1375.  
  1376. PP(pp_socket)
  1377. {
  1378.     dSP;
  1379. #ifdef HAS_SOCKET
  1380.     GV *gv;
  1381.     register IO *io;
  1382.     int protocol = POPi;
  1383.     int type = POPi;
  1384.     int domain = POPi;
  1385.     int fd;
  1386.  
  1387.     gv = (GV*)POPs;
  1388.  
  1389.     if (!gv) {
  1390.     SETERRNO(EBADF,LIB$_INVARG);
  1391.     RETPUSHUNDEF;
  1392.     }
  1393.  
  1394.     io = GvIOn(gv);
  1395.     if (IoIFP(io))
  1396.     do_close(gv, FALSE);
  1397.  
  1398.     TAINT_PROPER("socket");
  1399.     fd = socket(domain, type, protocol);
  1400.     if (fd < 0)
  1401.     RETPUSHUNDEF;
  1402.     IoIFP(io) = fdopen(fd, "r");    /* stdio gets confused about sockets */
  1403.     IoOFP(io) = fdopen(fd, "w");
  1404.     IoTYPE(io) = 's';
  1405.     if (!IoIFP(io) || !IoOFP(io)) {
  1406.     if (IoIFP(io)) fclose(IoIFP(io));
  1407.     if (IoOFP(io)) fclose(IoOFP(io));
  1408.     if (!IoIFP(io) && !IoOFP(io)) close(fd);
  1409.     RETPUSHUNDEF;
  1410.     }
  1411.  
  1412.     RETPUSHYES;
  1413. #else
  1414.     DIE(no_sock_func, "socket");
  1415. #endif
  1416. }
  1417.  
  1418. PP(pp_sockpair)
  1419. {
  1420.     dSP;
  1421. #ifdef HAS_SOCKETPAIR
  1422.     GV *gv1;
  1423.     GV *gv2;
  1424.     register IO *io1;
  1425.     register IO *io2;
  1426.     int protocol = POPi;
  1427.     int type = POPi;
  1428.     int domain = POPi;
  1429.     int fd[2];
  1430.  
  1431.     gv2 = (GV*)POPs;
  1432.     gv1 = (GV*)POPs;
  1433.     if (!gv1 || !gv2)
  1434.     RETPUSHUNDEF;
  1435.  
  1436.     io1 = GvIOn(gv1);
  1437.     io2 = GvIOn(gv2);
  1438.     if (IoIFP(io1))
  1439.     do_close(gv1, FALSE);
  1440.     if (IoIFP(io2))
  1441.     do_close(gv2, FALSE);
  1442.  
  1443.     TAINT_PROPER("socketpair");
  1444.     if (socketpair(domain, type, protocol, fd) < 0)
  1445.     RETPUSHUNDEF;
  1446.     IoIFP(io1) = fdopen(fd[0], "r");
  1447.     IoOFP(io1) = fdopen(fd[0], "w");
  1448.     IoTYPE(io1) = 's';
  1449.     IoIFP(io2) = fdopen(fd[1], "r");
  1450.     IoOFP(io2) = fdopen(fd[1], "w");
  1451.     IoTYPE(io2) = 's';
  1452.     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
  1453.     if (IoIFP(io1)) fclose(IoIFP(io1));
  1454.     if (IoOFP(io1)) fclose(IoOFP(io1));
  1455.     if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
  1456.     if (IoIFP(io2)) fclose(IoIFP(io2));
  1457.     if (IoOFP(io2)) fclose(IoOFP(io2));
  1458.     if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
  1459.     RETPUSHUNDEF;
  1460.     }
  1461.  
  1462.     RETPUSHYES;
  1463. #else
  1464.     DIE(no_sock_func, "socketpair");
  1465. #endif
  1466. }
  1467.  
  1468. PP(pp_bind)
  1469. {
  1470.     dSP;
  1471. #ifdef HAS_SOCKET
  1472.     SV *addrsv = POPs;
  1473.     char *addr;
  1474.     GV *gv = (GV*)POPs;
  1475.     register IO *io = GvIOn(gv);
  1476.     STRLEN len;
  1477.  
  1478.     if (!io || !IoIFP(io))
  1479.     goto nuts;
  1480.  
  1481.     addr = SvPV(addrsv, len);
  1482.     TAINT_PROPER("bind");
  1483.     if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
  1484.     RETPUSHYES;
  1485.     else
  1486.     RETPUSHUNDEF;
  1487.  
  1488. nuts:
  1489.     if (dowarn)
  1490.     warn("bind() on closed fd");
  1491.     SETERRNO(EBADF,SS$_IVCHAN);
  1492.     RETPUSHUNDEF;
  1493. #else
  1494.     DIE(no_sock_func, "bind");
  1495. #endif
  1496. }
  1497.  
  1498. PP(pp_connect)
  1499. {
  1500.     dSP;
  1501. #ifdef HAS_SOCKET
  1502.     SV *addrsv = POPs;
  1503.     char *addr;
  1504.     GV *gv = (GV*)POPs;
  1505.     register IO *io = GvIOn(gv);
  1506.     STRLEN len;
  1507.  
  1508.     if (!io || !IoIFP(io))
  1509.     goto nuts;
  1510.  
  1511.     addr = SvPV(addrsv, len);
  1512.     TAINT_PROPER("connect");
  1513.     if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
  1514.     RETPUSHYES;
  1515.     else
  1516.     RETPUSHUNDEF;
  1517.  
  1518. nuts:
  1519.     if (dowarn)
  1520.     warn("connect() on closed fd");
  1521.     SETERRNO(EBADF,SS$_IVCHAN);
  1522.     RETPUSHUNDEF;
  1523. #else
  1524.     DIE(no_sock_func, "connect");
  1525. #endif
  1526. }
  1527.  
  1528. PP(pp_listen)
  1529. {
  1530.     dSP;
  1531. #ifdef HAS_SOCKET
  1532.     int backlog = POPi;
  1533.     GV *gv = (GV*)POPs;
  1534.     register IO *io = GvIOn(gv);
  1535.  
  1536.     if (!io || !IoIFP(io))
  1537.     goto nuts;
  1538.  
  1539.     if (listen(fileno(IoIFP(io)), backlog) >= 0)
  1540.     RETPUSHYES;
  1541.     else
  1542.     RETPUSHUNDEF;
  1543.  
  1544. nuts:
  1545.     if (dowarn)
  1546.     warn("listen() on closed fd");
  1547.     SETERRNO(EBADF,SS$_IVCHAN);
  1548.     RETPUSHUNDEF;
  1549. #else
  1550.     DIE(no_sock_func, "listen");
  1551. #endif
  1552. }
  1553.  
  1554. PP(pp_accept)
  1555. {
  1556.     dSP; dTARGET;
  1557. #ifdef HAS_SOCKET
  1558.     GV *ngv;
  1559.     GV *ggv;
  1560.     register IO *nstio;
  1561.     register IO *gstio;
  1562.     struct sockaddr saddr;    /* use a struct to avoid alignment problems */
  1563.     int len = sizeof saddr;
  1564.     int fd;
  1565.  
  1566.     ggv = (GV*)POPs;
  1567.     ngv = (GV*)POPs;
  1568.  
  1569.     if (!ngv)
  1570.     goto badexit;
  1571.     if (!ggv)
  1572.     goto nuts;
  1573.  
  1574.     gstio = GvIO(ggv);
  1575.     if (!gstio || !IoIFP(gstio))
  1576.     goto nuts;
  1577.  
  1578.     nstio = GvIOn(ngv);
  1579.     if (IoIFP(nstio))
  1580.     do_close(ngv, FALSE);
  1581.  
  1582.     fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
  1583.     if (fd < 0)
  1584.     goto badexit;
  1585.     IoIFP(nstio) = fdopen(fd, "r");
  1586.     IoOFP(nstio) = fdopen(fd, "w");
  1587.     IoTYPE(nstio) = 's';
  1588.     if (!IoIFP(nstio) || !IoOFP(nstio)) {
  1589.     if (IoIFP(nstio)) fclose(IoIFP(nstio));
  1590.     if (IoOFP(nstio)) fclose(IoOFP(nstio));
  1591.     if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
  1592.     goto badexit;
  1593.     }
  1594.  
  1595.     PUSHp((char *)&saddr, len);
  1596.     RETURN;
  1597.  
  1598. nuts:
  1599.     if (dowarn)
  1600.     warn("accept() on closed fd");
  1601.     SETERRNO(EBADF,SS$_IVCHAN);
  1602.  
  1603. badexit:
  1604.     RETPUSHUNDEF;
  1605.  
  1606. #else
  1607.     DIE(no_sock_func, "accept");
  1608. #endif
  1609. }
  1610.  
  1611. PP(pp_shutdown)
  1612. {
  1613.     dSP; dTARGET;
  1614. #ifdef HAS_SOCKET
  1615.     int how = POPi;
  1616.     GV *gv = (GV*)POPs;
  1617.     register IO *io = GvIOn(gv);
  1618.  
  1619.     if (!io || !IoIFP(io))
  1620.     goto nuts;
  1621.  
  1622.     PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 );
  1623.     RETURN;
  1624.  
  1625. nuts:
  1626.     if (dowarn)
  1627.     warn("shutdown() on closed fd");
  1628.     SETERRNO(EBADF,SS$_IVCHAN);
  1629.     RETPUSHUNDEF;
  1630. #else
  1631.     DIE(no_sock_func, "shutdown");
  1632. #endif
  1633. }
  1634.  
  1635. PP(pp_gsockopt)
  1636. {
  1637. #ifdef HAS_SOCKET
  1638.     return pp_ssockopt(ARGS);
  1639. #else
  1640.     DIE(no_sock_func, "getsockopt");
  1641. #endif
  1642. }
  1643.  
  1644. PP(pp_ssockopt)
  1645. {
  1646.     dSP;
  1647. #ifdef HAS_SOCKET
  1648.     int optype = op->op_type;
  1649.     SV *sv;
  1650.     int fd;
  1651.     unsigned int optname;
  1652.     unsigned int lvl;
  1653.     GV *gv;
  1654.     register IO *io;
  1655.     int aint;
  1656.  
  1657.     if (optype == OP_GSOCKOPT)
  1658.     sv = sv_2mortal(NEWSV(22, 257));
  1659.     else
  1660.     sv = POPs;
  1661.     optname = (unsigned int) POPi;
  1662.     lvl = (unsigned int) POPi;
  1663.  
  1664.     gv = (GV*)POPs;
  1665.     io = GvIOn(gv);
  1666.     if (!io || !IoIFP(io))
  1667.     goto nuts;
  1668.  
  1669.     fd = fileno(IoIFP(io));
  1670.     switch (optype) {
  1671.     case OP_GSOCKOPT:
  1672.     SvGROW(sv, 257);
  1673.     (void)SvPOK_only(sv);
  1674.     SvCUR_set(sv,256);
  1675.     *SvEND(sv) ='\0';
  1676.     aint = SvCUR(sv);
  1677.     if (getsockopt(fd, lvl, optname, SvPVX(sv), &aint) < 0)
  1678.         goto nuts2;
  1679.     SvCUR_set(sv,aint);
  1680.     *SvEND(sv) ='\0';
  1681.     PUSHs(sv);
  1682.     break;
  1683.     case OP_SSOCKOPT: {
  1684.         STRLEN len = 0;
  1685.         char *buf = 0;
  1686.         if (SvPOKp(sv))
  1687.         buf = SvPV(sv, len);
  1688.         else if (SvOK(sv)) {
  1689.         aint = (int)SvIV(sv);
  1690.         buf = (char*)&aint;
  1691.         len = sizeof(int);
  1692.         }
  1693.         if (setsockopt(fd, lvl, optname, buf, (int)len) < 0)
  1694.         goto nuts2;
  1695.         PUSHs(&sv_yes);
  1696.     }
  1697.     break;
  1698.     }
  1699.     RETURN;
  1700.  
  1701. nuts:
  1702.     if (dowarn)
  1703.     warn("[gs]etsockopt() on closed fd");
  1704.     SETERRNO(EBADF,SS$_IVCHAN);
  1705. nuts2:
  1706.     RETPUSHUNDEF;
  1707.  
  1708. #else
  1709.     DIE(no_sock_func, "setsockopt");
  1710. #endif
  1711. }
  1712.  
  1713. PP(pp_getsockname)
  1714. {
  1715. #ifdef HAS_SOCKET
  1716.     return pp_getpeername(ARGS);
  1717. #else
  1718.     DIE(no_sock_func, "getsockname");
  1719. #endif
  1720. }
  1721.  
  1722. PP(pp_getpeername)
  1723. {
  1724.     dSP;
  1725. #ifdef HAS_SOCKET
  1726.     int optype = op->op_type;
  1727.     SV *sv;
  1728.     int fd;
  1729.     GV *gv = (GV*)POPs;
  1730.     register IO *io = GvIOn(gv);
  1731.     int aint;
  1732.  
  1733.     if (!io || !IoIFP(io))
  1734.     goto nuts;
  1735.  
  1736.     sv = sv_2mortal(NEWSV(22, 257));
  1737.     (void)SvPOK_only(sv);
  1738.     SvCUR_set(sv,256);
  1739.     *SvEND(sv) ='\0';
  1740.     aint = SvCUR(sv);
  1741.     fd = fileno(IoIFP(io));
  1742.     switch (optype) {
  1743.     case OP_GETSOCKNAME:
  1744.     if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
  1745.         goto nuts2;
  1746.     break;
  1747.     case OP_GETPEERNAME:
  1748.     if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
  1749.         goto nuts2;
  1750.     break;
  1751.     }
  1752.     SvCUR_set(sv,aint);
  1753.     *SvEND(sv) ='\0';
  1754.     PUSHs(sv);
  1755.     RETURN;
  1756.  
  1757. nuts:
  1758.     if (dowarn)
  1759.     warn("get{sock, peer}name() on closed fd");
  1760.     SETERRNO(EBADF,SS$_IVCHAN);
  1761. nuts2:
  1762.     RETPUSHUNDEF;
  1763.  
  1764. #else
  1765.     DIE(no_sock_func, "getpeername");
  1766. #endif
  1767. }
  1768.  
  1769. /* Stat calls. */
  1770.  
  1771. PP(pp_lstat)
  1772. {
  1773.     return pp_stat(ARGS);
  1774. }
  1775.  
  1776. PP(pp_stat)
  1777. {
  1778.     dSP;
  1779.     GV *tmpgv;
  1780.     I32 max = 13;
  1781.  
  1782.     if (op->op_flags & OPf_REF) {
  1783.     tmpgv = cGVOP->op_gv;
  1784.       do_fstat:
  1785.     if (tmpgv != defgv) {
  1786.         laststype = OP_STAT;
  1787.         statgv = tmpgv;
  1788.         sv_setpv(statname, "");
  1789.         if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1790.           Fstat(fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) {
  1791.         max = 0;
  1792.         laststatval = -1;
  1793.         }
  1794.     }
  1795.     else if (laststatval < 0)
  1796.         max = 0;
  1797.     }
  1798.     else {
  1799.     SV* sv = POPs;
  1800.     if (SvTYPE(sv) == SVt_PVGV) {
  1801.         tmpgv = (GV*)sv;
  1802.         goto do_fstat;
  1803.     }
  1804.     else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
  1805.         tmpgv = (GV*)SvRV(sv);
  1806.         goto do_fstat;
  1807.     }
  1808.     sv_setpv(statname, SvPV(sv,na));
  1809.     statgv = Nullgv;
  1810. #ifdef HAS_LSTAT
  1811.     laststype = op->op_type;
  1812.     if (op->op_type == OP_LSTAT)
  1813.         laststatval = lstat(SvPV(statname, na), &statcache);
  1814.     else
  1815. #endif
  1816.         laststatval = Stat(SvPV(statname, na), &statcache);
  1817.     if (laststatval < 0) {
  1818.         if (dowarn && strchr(SvPV(statname, na), '\n'))
  1819.         warn(warn_nl, "stat");
  1820.         max = 0;
  1821.     }
  1822.     }
  1823.  
  1824.     EXTEND(SP, 13);
  1825.     if (GIMME != G_ARRAY) {
  1826.     if (max)
  1827.         RETPUSHYES;
  1828.     else
  1829.         RETPUSHUNDEF;
  1830.     }
  1831.     if (max) {
  1832.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
  1833.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
  1834.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
  1835.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
  1836.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
  1837.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
  1838.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
  1839.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
  1840. #ifdef BIG_TIME
  1841.     PUSHs(sv_2mortal(newSVnv((U32)statcache.st_atime)));
  1842.     PUSHs(sv_2mortal(newSVnv((U32)statcache.st_mtime)));
  1843.     PUSHs(sv_2mortal(newSVnv((U32)statcache.st_ctime)));
  1844. #else
  1845.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
  1846.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
  1847.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
  1848. #endif
  1849. #ifdef USE_STAT_BLOCKS
  1850.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
  1851.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
  1852. #else
  1853.     PUSHs(sv_2mortal(newSVpv("", 0)));
  1854.     PUSHs(sv_2mortal(newSVpv("", 0)));
  1855. #endif
  1856.     }
  1857.     RETURN;
  1858. }
  1859.  
  1860. PP(pp_ftrread)
  1861. {
  1862.     I32 result = my_stat(ARGS);
  1863.     dSP;
  1864.     if (result < 0)
  1865.     RETPUSHUNDEF;
  1866.     if (cando(S_IRUSR, 0, &statcache))
  1867.     RETPUSHYES;
  1868.     RETPUSHNO;
  1869. }
  1870.  
  1871. PP(pp_ftrwrite)
  1872. {
  1873.     I32 result = my_stat(ARGS);
  1874.     dSP;
  1875.     if (result < 0)
  1876.     RETPUSHUNDEF;
  1877.     if (cando(S_IWUSR, 0, &statcache))
  1878.     RETPUSHYES;
  1879.     RETPUSHNO;
  1880. }
  1881.  
  1882. PP(pp_ftrexec)
  1883. {
  1884.     I32 result = my_stat(ARGS);
  1885.     dSP;
  1886.     if (result < 0)
  1887.     RETPUSHUNDEF;
  1888.     if (cando(S_IXUSR, 0, &statcache))
  1889.     RETPUSHYES;
  1890.     RETPUSHNO;
  1891. }
  1892.  
  1893. PP(pp_fteread)
  1894. {
  1895.     I32 result = my_stat(ARGS);
  1896.     dSP;
  1897.     if (result < 0)
  1898.     RETPUSHUNDEF;
  1899.     if (cando(S_IRUSR, 1, &statcache))
  1900.     RETPUSHYES;
  1901.     RETPUSHNO;
  1902. }
  1903.  
  1904. PP(pp_ftewrite)
  1905. {
  1906.     I32 result = my_stat(ARGS);
  1907.     dSP;
  1908.     if (result < 0)
  1909.     RETPUSHUNDEF;
  1910.     if (cando(S_IWUSR, 1, &statcache))
  1911.     RETPUSHYES;
  1912.     RETPUSHNO;
  1913. }
  1914.  
  1915. PP(pp_fteexec)
  1916. {
  1917.     I32 result = my_stat(ARGS);
  1918.     dSP;
  1919.     if (result < 0)
  1920.     RETPUSHUNDEF;
  1921.     if (cando(S_IXUSR, 1, &statcache))
  1922.     RETPUSHYES;
  1923.     RETPUSHNO;
  1924. }
  1925.  
  1926. PP(pp_ftis)
  1927. {
  1928.     I32 result = my_stat(ARGS);
  1929.     dSP;
  1930.     if (result < 0)
  1931.     RETPUSHUNDEF;
  1932.     RETPUSHYES;
  1933. }
  1934.  
  1935. PP(pp_fteowned)
  1936. {
  1937.     return pp_ftrowned(ARGS);
  1938. }
  1939.  
  1940. PP(pp_ftrowned)
  1941. {
  1942.     I32 result = my_stat(ARGS);
  1943.     dSP;
  1944.     if (result < 0)
  1945.     RETPUSHUNDEF;
  1946.     if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
  1947.     RETPUSHYES;
  1948.     RETPUSHNO;
  1949. }
  1950.  
  1951. PP(pp_ftzero)
  1952. {
  1953.     I32 result = my_stat(ARGS);
  1954.     dSP;
  1955.     if (result < 0)
  1956.     RETPUSHUNDEF;
  1957.     if (!statcache.st_size)
  1958.     RETPUSHYES;
  1959.     RETPUSHNO;
  1960. }
  1961.  
  1962. PP(pp_ftsize)
  1963. {
  1964.     I32 result = my_stat(ARGS);
  1965.     dSP; dTARGET;
  1966.     if (result < 0)
  1967.     RETPUSHUNDEF;
  1968.     PUSHi(statcache.st_size);
  1969.     RETURN;
  1970. }
  1971.  
  1972. PP(pp_ftmtime)
  1973. {
  1974.     I32 result = my_stat(ARGS);
  1975.     dSP; dTARGET;
  1976.     if (result < 0)
  1977.     RETPUSHUNDEF;
  1978.     PUSHn( ((I32)basetime - (I32)statcache.st_mtime) / 86400.0 );
  1979.     RETURN;
  1980. }
  1981.  
  1982. PP(pp_ftatime)
  1983. {
  1984.     I32 result = my_stat(ARGS);
  1985.     dSP; dTARGET;
  1986.     if (result < 0)
  1987.     RETPUSHUNDEF;
  1988.     PUSHn( ((I32)basetime - (I32)statcache.st_atime) / 86400.0 );
  1989.     RETURN;
  1990. }
  1991.  
  1992. PP(pp_ftctime)
  1993. {
  1994.     I32 result = my_stat(ARGS);
  1995.     dSP; dTARGET;
  1996.     if (result < 0)
  1997.     RETPUSHUNDEF;
  1998.     PUSHn( ((I32)basetime - (I32)statcache.st_ctime) / 86400.0 );
  1999.     RETURN;
  2000. }
  2001.  
  2002. PP(pp_ftsock)
  2003. {
  2004.     I32 result = my_stat(ARGS);
  2005.     dSP;
  2006.     if (result < 0)
  2007.     RETPUSHUNDEF;
  2008.     if (S_ISSOCK(statcache.st_mode))
  2009.     RETPUSHYES;
  2010.     RETPUSHNO;
  2011. }
  2012.  
  2013. PP(pp_ftchr)
  2014. {
  2015.     I32 result = my_stat(ARGS);
  2016.     dSP;
  2017.     if (result < 0)
  2018.     RETPUSHUNDEF;
  2019.     if (S_ISCHR(statcache.st_mode))
  2020.     RETPUSHYES;
  2021.     RETPUSHNO;
  2022. }
  2023.  
  2024. PP(pp_ftblk)
  2025. {
  2026.     I32 result = my_stat(ARGS);
  2027.     dSP;
  2028.     if (result < 0)
  2029.     RETPUSHUNDEF;
  2030.     if (S_ISBLK(statcache.st_mode))
  2031.     RETPUSHYES;
  2032.     RETPUSHNO;
  2033. }
  2034.  
  2035. PP(pp_ftfile)
  2036. {
  2037.     I32 result = my_stat(ARGS);
  2038.     dSP;
  2039.     if (result < 0)
  2040.     RETPUSHUNDEF;
  2041.     if (S_ISREG(statcache.st_mode))
  2042.     RETPUSHYES;
  2043.     RETPUSHNO;
  2044. }
  2045.  
  2046. PP(pp_ftdir)
  2047. {
  2048.     I32 result = my_stat(ARGS);
  2049.     dSP;
  2050.     if (result < 0)
  2051.     RETPUSHUNDEF;
  2052.     if (S_ISDIR(statcache.st_mode))
  2053.     RETPUSHYES;
  2054.     RETPUSHNO;
  2055. }
  2056.  
  2057. PP(pp_ftpipe)
  2058. {
  2059.     I32 result = my_stat(ARGS);
  2060.     dSP;
  2061.     if (result < 0)
  2062.     RETPUSHUNDEF;
  2063.     if (S_ISFIFO(statcache.st_mode))
  2064.     RETPUSHYES;
  2065.     RETPUSHNO;
  2066. }
  2067.  
  2068. PP(pp_ftlink)
  2069. {
  2070.     I32 result = my_lstat(ARGS);
  2071.     dSP;
  2072.     if (result < 0)
  2073.     RETPUSHUNDEF;
  2074.     if (S_ISLNK(statcache.st_mode))
  2075.     RETPUSHYES;
  2076.     RETPUSHNO;
  2077. }
  2078.  
  2079. PP(pp_ftsuid)
  2080. {
  2081.     dSP;
  2082. #ifdef S_ISUID
  2083.     I32 result = my_stat(ARGS);
  2084.     SPAGAIN;
  2085.     if (result < 0)
  2086.     RETPUSHUNDEF;
  2087.     if (statcache.st_mode & S_ISUID)
  2088.     RETPUSHYES;
  2089. #endif
  2090.     RETPUSHNO;
  2091. }
  2092.  
  2093. PP(pp_ftsgid)
  2094. {
  2095.     dSP;
  2096. #ifdef S_ISGID
  2097.     I32 result = my_stat(ARGS);
  2098.     SPAGAIN;
  2099.     if (result < 0)
  2100.     RETPUSHUNDEF;
  2101.     if (statcache.st_mode & S_ISGID)
  2102.     RETPUSHYES;
  2103. #endif
  2104.     RETPUSHNO;
  2105. }
  2106.  
  2107. PP(pp_ftsvtx)
  2108. {
  2109.     dSP;
  2110. #ifdef S_ISVTX
  2111.     I32 result = my_stat(ARGS);
  2112.     SPAGAIN;
  2113.     if (result < 0)
  2114.     RETPUSHUNDEF;
  2115.     if (statcache.st_mode & S_ISVTX)
  2116.     RETPUSHYES;
  2117. #endif
  2118.     RETPUSHNO;
  2119. }
  2120.  
  2121. PP(pp_fttty)
  2122. {
  2123.     dSP;
  2124.     int fd;
  2125.     GV *gv;
  2126.     char *tmps;
  2127.     if (op->op_flags & OPf_REF) {
  2128.     gv = cGVOP->op_gv;
  2129.     tmps = "";
  2130.     }
  2131.     else
  2132.     gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
  2133.     if (GvIO(gv) && IoIFP(GvIOp(gv)))
  2134.     fd = fileno(IoIFP(GvIOp(gv)));
  2135.     else if (isDIGIT(*tmps))
  2136.     fd = atoi(tmps);
  2137.     else
  2138.     RETPUSHUNDEF;
  2139.     if (isatty(fd))
  2140.     RETPUSHYES;
  2141.     RETPUSHNO;
  2142. }
  2143.  
  2144. #if defined(atarist) /* this will work with atariST. Configure will
  2145.             make guesses for other systems. */
  2146. # define FILE_base(f) ((f)->_base)
  2147. # define FILE_ptr(f) ((f)->_ptr)
  2148. # define FILE_cnt(f) ((f)->_cnt)
  2149. # define FILE_bufsiz(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
  2150. #endif
  2151.  
  2152. PP(pp_fttext)
  2153. {
  2154.     dSP;
  2155.     I32 i;
  2156.     I32 len;
  2157.     I32 odd = 0;
  2158.     STDCHAR tbuf[512];
  2159.     register STDCHAR *s;
  2160.     register IO *io;
  2161.     SV *sv;
  2162.  
  2163.     if (op->op_flags & OPf_REF) {
  2164.     EXTEND(SP, 1);
  2165.     if (cGVOP->op_gv == defgv) {
  2166.         if (statgv)
  2167.         io = GvIO(statgv);
  2168.         else {
  2169.         sv = statname;
  2170.         goto really_filename;
  2171.         }
  2172.     }
  2173.     else {
  2174.         statgv = cGVOP->op_gv;
  2175.         sv_setpv(statname, "");
  2176.         io = GvIO(statgv);
  2177.     }
  2178.     if (io && IoIFP(io)) {
  2179. #ifdef FILE_base
  2180.         Fstat(fileno(IoIFP(io)), &statcache);
  2181.         if (S_ISDIR(statcache.st_mode))    /* handle NFS glitch */
  2182.         if (op->op_type == OP_FTTEXT)
  2183.             RETPUSHNO;
  2184.         else
  2185.             RETPUSHYES;
  2186.         if (FILE_cnt(IoIFP(io)) <= 0) {
  2187.         i = getc(IoIFP(io));
  2188.         if (i != EOF)
  2189.             (void)ungetc(i, IoIFP(io));
  2190.         }
  2191.         if (FILE_cnt(IoIFP(io)) <= 0)    /* null file is anything */
  2192.         RETPUSHYES;
  2193.         len = FILE_bufsiz(IoIFP(io));
  2194.         s = FILE_base(IoIFP(io));
  2195. #else
  2196.         DIE("-T and -B not implemented on filehandles");
  2197. #endif
  2198.     }
  2199.     else {
  2200.         if (dowarn)
  2201.         warn("Test on unopened file <%s>",
  2202.           GvENAME(cGVOP->op_gv));
  2203.         SETERRNO(EBADF,RMS$_IFI);
  2204.         RETPUSHUNDEF;
  2205.     }
  2206.     }
  2207.     else {
  2208.     sv = POPs;
  2209.     statgv = Nullgv;
  2210.     sv_setpv(statname, SvPV(sv, na));
  2211.       really_filename:
  2212. #ifdef HAS_OPEN3
  2213.     i = open(SvPV(sv, na), O_RDONLY, 0);
  2214. #else
  2215.     i = open(SvPV(sv, na), 0);
  2216. #endif
  2217.     if (i < 0) {
  2218.         if (dowarn && strchr(SvPV(sv, na), '\n'))
  2219.         warn(warn_nl, "open");
  2220.         RETPUSHUNDEF;
  2221.     }
  2222.     Fstat(i, &statcache);
  2223. #ifdef macintosh
  2224.     len = read(i, (void *) tbuf, 512);
  2225. #else
  2226.     len = read(i, tbuf, 512);
  2227. #endif
  2228.     (void)close(i);
  2229.     if (len <= 0) {
  2230.         if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
  2231.         RETPUSHNO;        /* special case NFS directories */
  2232.         RETPUSHYES;        /* null file is anything */
  2233.     }
  2234.     s = tbuf;
  2235.     }
  2236.  
  2237.     /* now scan s to look for textiness */
  2238.     /*   XXX ASCII dependent code */
  2239.  
  2240.     for (i = 0; i < len; i++, s++) {
  2241.     if (!*s) {            /* null never allowed in text */
  2242.         odd += len;
  2243.         break;
  2244.     }
  2245.     else if (*s & 128)
  2246.         odd++;
  2247.     else if (*s < 32 &&
  2248.       *s != '\n' && *s != '\r' && *s != '\b' &&
  2249.       *s != '\t' && *s != '\f' && *s != 27)
  2250.         odd++;
  2251.     }
  2252.  
  2253.     if ((odd * 3 > len) == (op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
  2254.     RETPUSHNO;
  2255.     else
  2256.     RETPUSHYES;
  2257. }
  2258.  
  2259. PP(pp_ftbinary)
  2260. {
  2261.     return pp_fttext(ARGS);
  2262. }
  2263.  
  2264. /* File calls. */
  2265.  
  2266. PP(pp_chdir)
  2267. {
  2268.     dSP; dTARGET;
  2269.     char *tmps;
  2270.     SV **svp;
  2271.  
  2272.     if (MAXARG < 1)
  2273.     tmps = Nullch;
  2274.     else
  2275.     tmps = POPp;
  2276.     if (!tmps || !*tmps) {
  2277.     svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
  2278.     if (svp)
  2279.         tmps = SvPV(*svp, na);
  2280.     }
  2281.     if (!tmps || !*tmps) {
  2282.     svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
  2283.     if (svp)
  2284.         tmps = SvPV(*svp, na);
  2285.     }
  2286.     TAINT_PROPER("chdir");
  2287.     PUSHi( chdir(tmps) >= 0 );
  2288. #ifdef VMS
  2289.     /* Clear the DEFAULT element of ENV so we'll get the new value
  2290.      * in the future. */
  2291.     hv_delete(GvHVn(envgv),"DEFAULT",7,G_DISCARD);
  2292. #endif
  2293.     RETURN;
  2294. }
  2295.  
  2296. PP(pp_chown)
  2297. {
  2298.     dSP; dMARK; dTARGET;
  2299.     I32 value;
  2300. #ifdef HAS_CHOWN
  2301.     value = (I32)apply(op->op_type, MARK, SP);
  2302.     SP = MARK;
  2303.     PUSHi(value);
  2304.     RETURN;
  2305. #else
  2306.     DIE(no_func, "Unsupported function chown");
  2307. #endif
  2308. }
  2309.  
  2310. PP(pp_chroot)
  2311. {
  2312.     dSP; dTARGET;
  2313.     char *tmps;
  2314. #ifdef HAS_CHROOT
  2315.     tmps = POPp;
  2316.     TAINT_PROPER("chroot");
  2317.     PUSHi( chroot(tmps) >= 0 );
  2318.     RETURN;
  2319. #else
  2320.     DIE(no_func, "chroot");
  2321. #endif
  2322. }
  2323.  
  2324. PP(pp_unlink)
  2325. {
  2326.     dSP; dMARK; dTARGET;
  2327.     I32 value;
  2328.     value = (I32)apply(op->op_type, MARK, SP);
  2329.     SP = MARK;
  2330.     PUSHi(value);
  2331.     RETURN;
  2332. }
  2333.  
  2334. PP(pp_chmod)
  2335. {
  2336.     dSP; dMARK; dTARGET;
  2337.     I32 value;
  2338.     value = (I32)apply(op->op_type, MARK, SP);
  2339.     SP = MARK;
  2340.     PUSHi(value);
  2341.     RETURN;
  2342. }
  2343.  
  2344. PP(pp_utime)
  2345. {
  2346.     dSP; dMARK; dTARGET;
  2347.     I32 value;
  2348.     value = (I32)apply(op->op_type, MARK, SP);
  2349.     SP = MARK;
  2350.     PUSHi(value);
  2351.     RETURN;
  2352. }
  2353.  
  2354. PP(pp_rename)
  2355. {
  2356.     dSP; dTARGET;
  2357.     int anum;
  2358.  
  2359.     char *tmps2 = POPp;
  2360.     char *tmps = SvPV(TOPs, na);
  2361.     TAINT_PROPER("rename");
  2362. #ifdef HAS_RENAME
  2363.     anum = rename(tmps, tmps2);
  2364. #else
  2365.     if (same_dirent(tmps2, tmps))    /* can always rename to same name */
  2366.     anum = 1;
  2367.     else {
  2368.     if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
  2369.         (void)UNLINK(tmps2);
  2370.     if (!(anum = link(tmps, tmps2)))
  2371.         anum = UNLINK(tmps);
  2372.     }
  2373. #endif
  2374.     SETi( anum >= 0 );
  2375.     RETURN;
  2376. }
  2377.  
  2378. PP(pp_link)
  2379. {
  2380.     dSP; dTARGET;
  2381. #ifdef HAS_LINK
  2382.     char *tmps2 = POPp;
  2383.     char *tmps = SvPV(TOPs, na);
  2384.     TAINT_PROPER("link");
  2385.     SETi( link(tmps, tmps2) >= 0 );
  2386. #else
  2387.     DIE(no_func, "Unsupported function link");
  2388. #endif
  2389.     RETURN;
  2390. }
  2391.  
  2392. PP(pp_symlink)
  2393. {
  2394.     dSP; dTARGET;
  2395. #ifdef HAS_SYMLINK
  2396.     char *tmps2 = POPp;
  2397.     char *tmps = SvPV(TOPs, na);
  2398.     TAINT_PROPER("symlink");
  2399.     SETi( symlink(tmps, tmps2) >= 0 );
  2400.     RETURN;
  2401. #else
  2402.     DIE(no_func, "symlink");
  2403. #endif
  2404. }
  2405.  
  2406. PP(pp_readlink)
  2407. {
  2408.     dSP; dTARGET;
  2409. #ifdef HAS_SYMLINK
  2410.     char *tmps;
  2411.     int len;
  2412.     tmps = POPp;
  2413.     len = readlink(tmps, buf, sizeof buf);
  2414.     EXTEND(SP, 1);
  2415.     if (len < 0)
  2416.     RETPUSHUNDEF;
  2417.     PUSHp(buf, len);
  2418.     RETURN;
  2419. #else
  2420.     EXTEND(SP, 1);
  2421.     RETSETUNDEF;        /* just pretend it's a normal file */
  2422. #endif
  2423. }
  2424.  
  2425. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  2426. static int
  2427. dooneliner(cmd, filename)
  2428. char *cmd;
  2429. char *filename;
  2430. {
  2431.     char mybuf[8192];
  2432.     char *s,
  2433.      *save_filename = filename;
  2434.     int anum = 1;
  2435.     FILE *myfp;
  2436.  
  2437.     strcpy(mybuf, cmd);
  2438.     strcat(mybuf, " ");
  2439.     for (s = mybuf+strlen(mybuf); *filename; ) {
  2440.     *s++ = '\\';
  2441.     *s++ = *filename++;
  2442.     }
  2443.     strcpy(s, " 2>&1");
  2444.     myfp = my_popen(mybuf, "r");
  2445.     if (myfp) {
  2446.     *mybuf = '\0';
  2447.     s = fgets(mybuf, sizeof mybuf, myfp);
  2448.     (void)my_pclose(myfp);
  2449.     if (s != Nullch) {
  2450.         for (errno = 1; errno < sys_nerr; errno++) {
  2451. #ifdef HAS_SYS_ERRLIST
  2452.         if (instr(mybuf, sys_errlist[errno]))    /* you don't see this */
  2453.             return 0;
  2454. #else
  2455.         char *errmsg;                /* especially if it isn't there */
  2456.  
  2457.         if (instr(mybuf,
  2458.                   (errmsg = strerror(errno)) ? errmsg : "NoErRoR"))
  2459.             return 0;
  2460. #endif
  2461.         }
  2462.         SETERRNO(0,0);
  2463. #ifndef EACCES
  2464. #define EACCES EPERM
  2465. #endif
  2466.         if (instr(mybuf, "cannot make"))
  2467.         SETERRNO(EEXIST,RMS$_FEX);
  2468.         else if (instr(mybuf, "existing file"))
  2469.         SETERRNO(EEXIST,RMS$_FEX);
  2470.         else if (instr(mybuf, "ile exists"))
  2471.         SETERRNO(EEXIST,RMS$_FEX);
  2472.         else if (instr(mybuf, "non-exist"))
  2473.         SETERRNO(ENOENT,RMS$_FNF);
  2474.         else if (instr(mybuf, "does not exist"))
  2475.         SETERRNO(ENOENT,RMS$_FNF);
  2476.         else if (instr(mybuf, "not empty"))
  2477.         SETERRNO(EBUSY,SS$_DEVOFFLINE);
  2478.         else if (instr(mybuf, "cannot access"))
  2479.         SETERRNO(EACCES,RMS$_PRV);
  2480.         else
  2481.         SETERRNO(EPERM,RMS$_PRV);
  2482.         return 0;
  2483.     }
  2484.     else {    /* some mkdirs return no failure indication */
  2485.         anum = (Stat(save_filename, &statbuf) >= 0);
  2486.         if (op->op_type == OP_RMDIR)
  2487.         anum = !anum;
  2488.         if (anum)
  2489.         SETERRNO(0,0);
  2490.         else
  2491.         SETERRNO(EACCES,RMS$_PRV);    /* a guess */
  2492.     }
  2493.     return anum;
  2494.     }
  2495.     else
  2496.     return 0;
  2497. }
  2498. #endif
  2499.  
  2500. PP(pp_mkdir)
  2501. {
  2502.     dSP; dTARGET;
  2503.     int mode = POPi;
  2504. #ifndef HAS_MKDIR
  2505.     int oldumask;
  2506. #endif
  2507.     char *tmps = SvPV(TOPs, na);
  2508.  
  2509.     TAINT_PROPER("mkdir");
  2510. #ifdef HAS_MKDIR
  2511.     SETi( mkdir(tmps, mode) >= 0 );
  2512. #else
  2513.     SETi( dooneliner("mkdir", tmps) );
  2514.     oldumask = umask(0);
  2515.     umask(oldumask);
  2516.     chmod(tmps, (mode & ~oldumask) & 0777);
  2517. #endif
  2518.     RETURN;
  2519. }
  2520.  
  2521. PP(pp_rmdir)
  2522. {
  2523.     dSP; dTARGET;
  2524.     char *tmps;
  2525.  
  2526.     tmps = POPp;
  2527.     TAINT_PROPER("rmdir");
  2528. #ifdef HAS_RMDIR
  2529.     XPUSHi( rmdir(tmps) >= 0 );
  2530. #else
  2531.     XPUSHi( dooneliner("rmdir", tmps) );
  2532. #endif
  2533.     RETURN;
  2534. }
  2535.  
  2536. /* Directory calls. */
  2537.  
  2538. PP(pp_open_dir)
  2539. {
  2540.     dSP;
  2541. #if defined(Direntry_t) && defined(HAS_READDIR)
  2542.     char *dirname = POPp;
  2543.     GV *gv = (GV*)POPs;
  2544.     register IO *io = GvIOn(gv);
  2545.  
  2546.     if (!io)
  2547.     goto nope;
  2548.  
  2549.     if (IoDIRP(io))
  2550.     closedir(IoDIRP(io));
  2551.     if (!(IoDIRP(io) = opendir(dirname)))
  2552.     goto nope;
  2553.  
  2554.     RETPUSHYES;
  2555. nope:
  2556.     if (!errno)
  2557.     SETERRNO(EBADF,RMS$_DIR);
  2558.     RETPUSHUNDEF;
  2559. #else
  2560.     DIE(no_dir_func, "opendir");
  2561. #endif
  2562. }
  2563.  
  2564. PP(pp_readdir)
  2565. {
  2566.     dSP;
  2567. #if defined(Direntry_t) && defined(HAS_READDIR)
  2568. #ifndef I_DIRENT
  2569.     Direntry_t *readdir _((DIR *));
  2570. #endif
  2571.     register Direntry_t *dp;
  2572.     GV *gv = (GV*)POPs;
  2573.     register IO *io = GvIOn(gv);
  2574.  
  2575.     if (!io || !IoDIRP(io))
  2576.     goto nope;
  2577.  
  2578.     if (GIMME == G_ARRAY) {
  2579.     /*SUPPRESS 560*/
  2580.     while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
  2581. #ifdef DIRNAMLEN
  2582.         XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
  2583. #else
  2584.         XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
  2585. #endif
  2586.     }
  2587.     }
  2588.     else {
  2589.     if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
  2590.         goto nope;
  2591. #ifdef DIRNAMLEN
  2592.     XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
  2593. #else
  2594.     XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
  2595. #endif
  2596.     }
  2597.     RETURN;
  2598.  
  2599. nope:
  2600.     if (!errno)
  2601.     SETERRNO(EBADF,RMS$_ISI);
  2602.     if (GIMME == G_ARRAY)
  2603.     RETURN;
  2604.     else
  2605.     RETPUSHUNDEF;
  2606. #else
  2607.     DIE(no_dir_func, "readdir");
  2608. #endif
  2609. }
  2610.  
  2611. PP(pp_telldir)
  2612. {
  2613.     dSP; dTARGET;
  2614. #if defined(HAS_TELLDIR) || defined(telldir)
  2615. #if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
  2616.     long telldir _((DIR *));
  2617. #endif
  2618.     GV *gv = (GV*)POPs;
  2619.     register IO *io = GvIOn(gv);
  2620.  
  2621.     if (!io || !IoDIRP(io))
  2622.     goto nope;
  2623.  
  2624.     PUSHi( telldir(IoDIRP(io)) );
  2625.     RETURN;
  2626. nope:
  2627.     if (!errno)
  2628.     SETERRNO(EBADF,RMS$_ISI);
  2629.     RETPUSHUNDEF;
  2630. #else
  2631.     DIE(no_dir_func, "telldir");
  2632. #endif
  2633. }
  2634.  
  2635. PP(pp_seekdir)
  2636. {
  2637.     dSP;
  2638. #if defined(HAS_SEEKDIR) || defined(seekdir)
  2639.     long along = POPl;
  2640.     GV *gv = (GV*)POPs;
  2641.     register IO *io = GvIOn(gv);
  2642.  
  2643.     if (!io || !IoDIRP(io))
  2644.     goto nope;
  2645.  
  2646.     (void)seekdir(IoDIRP(io), along);
  2647.  
  2648.     RETPUSHYES;
  2649. nope:
  2650.     if (!errno)
  2651.     SETERRNO(EBADF,RMS$_ISI);
  2652.     RETPUSHUNDEF;
  2653. #else
  2654.     DIE(no_dir_func, "seekdir");
  2655. #endif
  2656. }
  2657.  
  2658. PP(pp_rewinddir)
  2659. {
  2660.     dSP;
  2661. #if defined(HAS_REWINDDIR) || defined(rewinddir)
  2662.     GV *gv = (GV*)POPs;
  2663.     register IO *io = GvIOn(gv);
  2664.  
  2665.     if (!io || !IoDIRP(io))
  2666.     goto nope;
  2667.  
  2668.     (void)rewinddir(IoDIRP(io));
  2669.     RETPUSHYES;
  2670. nope:
  2671.     if (!errno)
  2672.     SETERRNO(EBADF,RMS$_ISI);
  2673.     RETPUSHUNDEF;
  2674. #else
  2675.     DIE(no_dir_func, "rewinddir");
  2676. #endif
  2677. }
  2678.  
  2679. PP(pp_closedir)
  2680. {
  2681.     dSP;
  2682. #if defined(Direntry_t) && defined(HAS_READDIR)
  2683.     GV *gv = (GV*)POPs;
  2684.     register IO *io = GvIOn(gv);
  2685.  
  2686.     if (!io || !IoDIRP(io))
  2687.     goto nope;
  2688.  
  2689. #ifdef VOID_CLOSEDIR
  2690.     closedir(IoDIRP(io));
  2691. #else
  2692.     if (closedir(IoDIRP(io)) < 0) {
  2693.     IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
  2694.     goto nope;
  2695.     }
  2696. #endif
  2697.     IoDIRP(io) = 0;
  2698.  
  2699.     RETPUSHYES;
  2700. nope:
  2701.     if (!errno)
  2702.     SETERRNO(EBADF,RMS$_IFI);
  2703.     RETPUSHUNDEF;
  2704. #else
  2705.     DIE(no_dir_func, "closedir");
  2706. #endif
  2707. }
  2708.  
  2709. /* Process control. */
  2710.  
  2711. PP(pp_fork)
  2712. {
  2713.     dSP; dTARGET;
  2714.     int childpid;
  2715.     GV *tmpgv;
  2716.  
  2717.     EXTEND(SP, 1);
  2718. #ifdef HAS_FORK
  2719.     childpid = fork();
  2720.     if (childpid < 0)
  2721.     RETSETUNDEF;
  2722.     if (!childpid) {
  2723.     /*SUPPRESS 560*/
  2724.     if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
  2725.         sv_setiv(GvSV(tmpgv), (I32)getpid());
  2726.     hv_clear(pidstatus);    /* no kids, so don't wait for 'em */
  2727.     }
  2728.     PUSHi(childpid);
  2729.     RETURN;
  2730. #else
  2731.     DIE(no_func, "Unsupported function fork");
  2732. #endif
  2733. }
  2734.  
  2735. PP(pp_wait)
  2736. {
  2737.     dSP; dTARGET;
  2738.     int childpid;
  2739.     int argflags;
  2740.     I32 value;
  2741.  
  2742.     EXTEND(SP, 1);
  2743. #ifdef HAS_WAIT
  2744.     childpid = wait(&argflags);
  2745.     if (childpid > 0)
  2746.     pidgone(childpid, argflags);
  2747.     value = (I32)childpid;
  2748.     statusvalue = FIXSTATUS(argflags);
  2749.     PUSHi(value);
  2750.     RETURN;
  2751. #else
  2752.     DIE(no_func, "Unsupported function wait");
  2753. #endif
  2754. }
  2755.  
  2756. PP(pp_waitpid)
  2757. {
  2758.     dSP; dTARGET;
  2759.     int childpid;
  2760.     int optype;
  2761.     int argflags;
  2762.     I32 value;
  2763.  
  2764. #ifdef HAS_WAIT
  2765.     optype = POPi;
  2766.     childpid = TOPi;
  2767.     childpid = wait4pid(childpid, &argflags, optype);
  2768.     value = (I32)childpid;
  2769.     statusvalue = FIXSTATUS(argflags);
  2770.     SETi(value);
  2771.     RETURN;
  2772. #else
  2773.     DIE(no_func, "Unsupported function wait");
  2774. #endif
  2775. }
  2776.  
  2777. PP(pp_system)
  2778. {
  2779.     dSP; dMARK; dORIGMARK; dTARGET;
  2780.     I32 value;
  2781.     int childpid;
  2782.     int result;
  2783.     int status;
  2784.     Signal_t (*ihand)();     /* place to save signal during system() */
  2785.     Signal_t (*qhand)();     /* place to save signal during system() */
  2786.  
  2787. #if defined(HAS_FORK) && !defined(VMS) && !defined(OS2)
  2788.     if (SP - MARK == 1) {
  2789.     if (tainting) {
  2790.         char *junk = SvPV(TOPs, na);
  2791.         TAINT_ENV();
  2792.         TAINT_PROPER("system");
  2793.     }
  2794.     }
  2795.     while ((childpid = vfork()) == -1) {
  2796.     if (errno != EAGAIN) {
  2797.         value = -1;
  2798.         SP = ORIGMARK;
  2799.         PUSHi(value);
  2800.         RETURN;
  2801.     }
  2802.     sleep(5);
  2803.     }
  2804.     if (childpid > 0) {
  2805.     ihand = signal(SIGINT, SIG_IGN);
  2806.     qhand = signal(SIGQUIT, SIG_IGN);
  2807.     do {
  2808.         result = wait4pid(childpid, &status, 0);
  2809.     } while (result == -1 && errno == EINTR);
  2810.     (void)signal(SIGINT, ihand);
  2811.     (void)signal(SIGQUIT, qhand);
  2812.     statusvalue = FIXSTATUS(status);
  2813.     if (result < 0)
  2814.         value = -1;
  2815.     else {
  2816.         value = (I32)((unsigned int)status & 0xffff);
  2817.     }
  2818.     do_execfree();    /* free any memory child malloced on vfork */
  2819.     SP = ORIGMARK;
  2820.     PUSHi(value);
  2821.     RETURN;
  2822.     }
  2823.     if (op->op_flags & OPf_STACKED) {
  2824.     SV *really = *++MARK;
  2825.     value = (I32)do_aexec(really, MARK, SP);
  2826.     }
  2827.     else if (SP - MARK != 1)
  2828.     value = (I32)do_aexec(Nullsv, MARK, SP);
  2829.     else {
  2830.     value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2831.     }
  2832.     _exit(-1);
  2833. #else /* ! FORK or VMS or OS/2 */
  2834.     if (op->op_flags & OPf_STACKED) {
  2835.     SV *really = *++MARK;
  2836.     value = (I32)do_aspawn(really, MARK, SP);
  2837.     }
  2838.     else if (SP - MARK != 1)
  2839.     value = (I32)do_aspawn(Nullsv, MARK, SP);
  2840.     else {
  2841.     value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
  2842.     }
  2843.     statusvalue = FIXSTATUS(value);
  2844.     do_execfree();
  2845.     SP = ORIGMARK;
  2846.     PUSHi(value);
  2847. #endif /* !FORK or VMS */
  2848.     RETURN;
  2849. }
  2850.  
  2851. PP(pp_exec)
  2852. {
  2853.     dSP; dMARK; dORIGMARK; dTARGET;
  2854.     I32 value;
  2855.  
  2856.     if (op->op_flags & OPf_STACKED) {
  2857.     SV *really = *++MARK;
  2858.     value = (I32)do_aexec(really, MARK, SP);
  2859.     }
  2860.     else if (SP - MARK != 1)
  2861. #ifdef VMS
  2862.     value = (I32)vms_do_aexec(Nullsv, MARK, SP);
  2863. #else
  2864.     value = (I32)do_aexec(Nullsv, MARK, SP);
  2865. #endif
  2866.     else {
  2867.     if (tainting) {
  2868.         char *junk = SvPV(*SP, na);
  2869.         TAINT_ENV();
  2870.         TAINT_PROPER("exec");
  2871.     }
  2872. #ifdef VMS
  2873.     value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2874. #else
  2875.     value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2876. #endif
  2877.     }
  2878.     SP = ORIGMARK;
  2879.     PUSHi(value);
  2880.     RETURN;
  2881. }
  2882.  
  2883. PP(pp_kill)
  2884. {
  2885.     dSP; dMARK; dTARGET;
  2886.     I32 value;
  2887. #ifdef HAS_KILL
  2888.     value = (I32)apply(op->op_type, MARK, SP);
  2889.     SP = MARK;
  2890.     PUSHi(value);
  2891.     RETURN;
  2892. #else
  2893.     DIE(no_func, "Unsupported function kill");
  2894. #endif
  2895. }
  2896.  
  2897. PP(pp_getppid)
  2898. {
  2899. #ifdef HAS_GETPPID
  2900.     dSP; dTARGET;
  2901.     XPUSHi( getppid() );
  2902.     RETURN;
  2903. #else
  2904.     DIE(no_func, "getppid");
  2905. #endif
  2906. }
  2907.  
  2908. PP(pp_getpgrp)
  2909. {
  2910. #ifdef HAS_GETPGRP
  2911.     dSP; dTARGET;
  2912.     int pid;
  2913.     I32 value;
  2914.  
  2915.     if (MAXARG < 1)
  2916.     pid = 0;
  2917.     else
  2918.     pid = SvIVx(POPs);
  2919. #ifdef BSD_GETPGRP
  2920.     value = (I32)BSD_GETPGRP(pid);
  2921. #else
  2922.     if (pid != 0)
  2923.     DIE("POSIX getpgrp can't take an argument");
  2924.     value = (I32)getpgrp();
  2925. #endif
  2926.     XPUSHi(value);
  2927.     RETURN;
  2928. #else
  2929.     DIE(no_func, "getpgrp()");
  2930. #endif
  2931. }
  2932.  
  2933. PP(pp_setpgrp)
  2934. {
  2935. #ifdef HAS_SETPGRP
  2936.     dSP; dTARGET;
  2937.     int pgrp;
  2938.     int pid;
  2939.     if (MAXARG < 2) {
  2940.     pgrp = 0;
  2941.     pid = 0;
  2942.     }
  2943.     else {
  2944.     pgrp = POPi;
  2945.     pid = TOPi;
  2946.     }
  2947.  
  2948.     TAINT_PROPER("setpgrp");
  2949. #ifdef BSD_SETPGRP
  2950.     SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
  2951. #else
  2952.     if ((pgrp != 0) || (pid != 0)) {
  2953.     DIE("POSIX setpgrp can't take an argument");
  2954.     }
  2955.     SETi( setpgrp() >= 0 );
  2956. #endif /* USE_BSDPGRP */
  2957.     RETURN;
  2958. #else
  2959.     DIE(no_func, "setpgrp()");
  2960. #endif
  2961. }
  2962.  
  2963. PP(pp_getpriority)
  2964. {
  2965.     dSP; dTARGET;
  2966.     int which;
  2967.     int who;
  2968. #ifdef HAS_GETPRIORITY
  2969.     who = POPi;
  2970.     which = TOPi;
  2971.     SETi( getpriority(which, who) );
  2972.     RETURN;
  2973. #else
  2974.     DIE(no_func, "getpriority()");
  2975. #endif
  2976. }
  2977.  
  2978. PP(pp_setpriority)
  2979. {
  2980.     dSP; dTARGET;
  2981.     int which;
  2982.     int who;
  2983.     int niceval;
  2984. #ifdef HAS_SETPRIORITY
  2985.     niceval = POPi;
  2986.     who = POPi;
  2987.     which = TOPi;
  2988.     TAINT_PROPER("setpriority");
  2989.     SETi( setpriority(which, who, niceval) >= 0 );
  2990.     RETURN;
  2991. #else
  2992.     DIE(no_func, "setpriority()");
  2993. #endif
  2994. }
  2995.  
  2996. /* Time calls. */
  2997.  
  2998. PP(pp_time)
  2999. {
  3000.     dSP; dTARGET;
  3001. #ifdef BIG_TIME
  3002.     XPUSHn( time(Null(Time_t*)) );
  3003. #else
  3004.     XPUSHi( time(Null(Time_t*)) );
  3005. #endif
  3006.     RETURN;
  3007. }
  3008.  
  3009. #ifndef HZ
  3010. #define HZ 60
  3011. #endif
  3012.  
  3013. PP(pp_tms)
  3014. {
  3015.     dSP;
  3016.  
  3017. #if defined(MSDOS) || !defined(HAS_TIMES)
  3018.     DIE("times not implemented");
  3019. #else
  3020.     EXTEND(SP, 4);
  3021.  
  3022. #ifndef VMS
  3023.     (void)times(×buf);
  3024. #else
  3025.     (void)times((tbuffer_t *)×buf);  /* time.h uses different name for */
  3026.                                           /* struct tms, though same data   */
  3027.                                           /* is returned.                   */
  3028. #undef HZ
  3029. #define HZ CLK_TCK
  3030. #endif
  3031.  
  3032.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
  3033.     if (GIMME == G_ARRAY) {
  3034.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
  3035.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
  3036.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
  3037.     }
  3038.     RETURN;
  3039. #endif /* MSDOS */
  3040. }
  3041.  
  3042. PP(pp_localtime)
  3043. {
  3044.     return pp_gmtime(ARGS);
  3045. }
  3046.  
  3047. PP(pp_gmtime)
  3048. {
  3049.     dSP;
  3050.     Time_t when;
  3051.     struct tm *tmbuf;
  3052.     static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
  3053.     static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
  3054.                   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
  3055.  
  3056.     if (MAXARG < 1)
  3057.     (void)time(&when);
  3058.     else
  3059. #ifdef BIG_TIME
  3060.     when = (Time_t)SvNVx(POPs);
  3061. #else
  3062.     when = (Time_t)SvIVx(POPs);
  3063. #endif
  3064.  
  3065.     if (op->op_type == OP_LOCALTIME)
  3066.     tmbuf = localtime(&when);
  3067.     else
  3068.     tmbuf = gmtime(&when);
  3069.  
  3070.     EXTEND(SP, 9);
  3071.     if (GIMME != G_ARRAY) {
  3072.     dTARGET;
  3073.     char mybuf[30];
  3074.     if (!tmbuf)
  3075.         RETPUSHUNDEF;
  3076.     sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
  3077.         dayname[tmbuf->tm_wday],
  3078.         monname[tmbuf->tm_mon],
  3079.         tmbuf->tm_mday,
  3080.         tmbuf->tm_hour,
  3081.         tmbuf->tm_min,
  3082.         tmbuf->tm_sec,
  3083.         tmbuf->tm_year + 1900);
  3084.     PUSHp(mybuf, strlen(mybuf));
  3085.     }
  3086.     else if (tmbuf) {
  3087.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
  3088.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
  3089.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
  3090.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
  3091.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
  3092.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
  3093.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
  3094.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
  3095.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
  3096.     }
  3097.     RETURN;
  3098. }
  3099.  
  3100. PP(pp_alarm)
  3101. {
  3102.     dSP; dTARGET;
  3103.     int anum;
  3104. #ifdef HAS_ALARM
  3105.     anum = POPi;
  3106.     anum = alarm((unsigned int)anum);
  3107.     EXTEND(SP, 1);
  3108.     if (anum < 0)
  3109.     RETPUSHUNDEF;
  3110.     PUSHi((I32)anum);
  3111.     RETURN;
  3112. #else
  3113.     DIE(no_func, "Unsupported function alarm");
  3114. #endif
  3115. }
  3116.  
  3117. PP(pp_sleep)
  3118. {
  3119.     dSP; dTARGET;
  3120.     I32 duration;
  3121.     Time_t lasttime;
  3122.     Time_t when;
  3123.  
  3124.     (void)time(&lasttime);
  3125.     if (MAXARG < 1)
  3126.     pause();
  3127.     else {
  3128.     duration = POPi;
  3129.     sleep((unsigned int)duration);
  3130.     }
  3131.     (void)time(&when);
  3132.     XPUSHi(when - lasttime);
  3133.     RETURN;
  3134. }
  3135.  
  3136. /* Shared memory. */
  3137.  
  3138. PP(pp_shmget)
  3139. {
  3140.     return pp_semget(ARGS);
  3141. }
  3142.  
  3143. PP(pp_shmctl)
  3144. {
  3145.     return pp_semctl(ARGS);
  3146. }
  3147.  
  3148. PP(pp_shmread)
  3149. {
  3150.     return pp_shmwrite(ARGS);
  3151. }
  3152.  
  3153. PP(pp_shmwrite)
  3154. {
  3155. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3156.     dSP; dMARK; dTARGET;
  3157.     I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
  3158.     SP = MARK;
  3159.     PUSHi(value);
  3160.     RETURN;
  3161. #else
  3162.     return pp_semget(ARGS);
  3163. #endif
  3164. }
  3165.  
  3166. /* Message passing. */
  3167.  
  3168. PP(pp_msgget)
  3169. {
  3170.     return pp_semget(ARGS);
  3171. }
  3172.  
  3173. PP(pp_msgctl)
  3174. {
  3175.     return pp_semctl(ARGS);
  3176. }
  3177.  
  3178. PP(pp_msgsnd)
  3179. {
  3180. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3181.     dSP; dMARK; dTARGET;
  3182.     I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
  3183.     SP = MARK;
  3184.     PUSHi(value);
  3185.     RETURN;
  3186. #else
  3187.     return pp_semget(ARGS);
  3188. #endif
  3189. }
  3190.  
  3191. PP(pp_msgrcv)
  3192. {
  3193. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3194.     dSP; dMARK; dTARGET;
  3195.     I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
  3196.     SP = MARK;
  3197.     PUSHi(value);
  3198.     RETURN;
  3199. #else
  3200.     return pp_semget(ARGS);
  3201. #endif
  3202. }
  3203.  
  3204. /* Semaphores. */
  3205.  
  3206. PP(pp_semget)
  3207. {
  3208. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3209.     dSP; dMARK; dTARGET;
  3210.     int anum = do_ipcget(op->op_type, MARK, SP);
  3211.     SP = MARK;
  3212.     if (anum == -1)
  3213.     RETPUSHUNDEF;
  3214.     PUSHi(anum);
  3215.     RETURN;
  3216. #else
  3217.     DIE("System V IPC is not implemented on this machine");
  3218. #endif
  3219. }
  3220.  
  3221. PP(pp_semctl)
  3222. {
  3223. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3224.     dSP; dMARK; dTARGET;
  3225.     int anum = do_ipcctl(op->op_type, MARK, SP);
  3226.     SP = MARK;
  3227.     if (anum == -1)
  3228.     RETSETUNDEF;
  3229.     if (anum != 0) {
  3230.     PUSHi(anum);
  3231.     }
  3232.     else {
  3233.     PUSHp("0 but true",10);
  3234.     }
  3235.     RETURN;
  3236. #else
  3237.     return pp_semget(ARGS);
  3238. #endif
  3239. }
  3240.  
  3241. PP(pp_semop)
  3242. {
  3243. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3244.     dSP; dMARK; dTARGET;
  3245.     I32 value = (I32)(do_semop(MARK, SP) >= 0);
  3246.     SP = MARK;
  3247.     PUSHi(value);
  3248.     RETURN;
  3249. #else
  3250.     return pp_semget(ARGS);
  3251. #endif
  3252. }
  3253.  
  3254. /* Get system info. */
  3255.  
  3256. PP(pp_ghbyname)
  3257. {
  3258. #ifdef HAS_SOCKET
  3259.     return pp_ghostent(ARGS);
  3260. #else
  3261.     DIE(no_sock_func, "gethostbyname");
  3262. #endif
  3263. }
  3264.  
  3265. PP(pp_ghbyaddr)
  3266. {
  3267. #ifdef HAS_SOCKET
  3268.     return pp_ghostent(ARGS);
  3269. #else
  3270.     DIE(no_sock_func, "gethostbyaddr");
  3271. #endif
  3272. }
  3273.  
  3274. PP(pp_ghostent)
  3275. {
  3276.     dSP;
  3277. #ifdef HAS_SOCKET
  3278.     I32 which = op->op_type;
  3279.     register char **elem;
  3280.     register SV *sv;
  3281.     struct hostent *gethostbyname();
  3282.     struct hostent *gethostbyaddr();
  3283. #ifdef HAS_GETHOSTENT
  3284.     struct hostent *gethostent();
  3285. #endif
  3286.     struct hostent *hent;
  3287.     unsigned long len;
  3288.  
  3289.     EXTEND(SP, 10);
  3290.     if (which == OP_GHBYNAME) {
  3291.     hent = gethostbyname(POPp);
  3292.     }
  3293.     else if (which == OP_GHBYADDR) {
  3294.     int addrtype = POPi;
  3295.     SV *addrsv = POPs;
  3296.     STRLEN addrlen;
  3297.     char *addr = SvPV(addrsv, addrlen);
  3298.  
  3299.     hent = gethostbyaddr(addr, addrlen, addrtype);
  3300.     }
  3301.     else
  3302. #ifdef HAS_GETHOSTENT
  3303.     hent = gethostent();
  3304. #else
  3305.     DIE("gethostent not implemented");
  3306. #endif
  3307.  
  3308. #ifdef HOST_NOT_FOUND
  3309.     if (!hent)
  3310.     statusvalue = FIXSTATUS(h_errno);
  3311. #endif
  3312.  
  3313.     if (GIMME != G_ARRAY) {
  3314.     PUSHs(sv = sv_newmortal());
  3315.     if (hent) {
  3316.         if (which == OP_GHBYNAME) {
  3317.         if (hent->h_addr)
  3318.             sv_setpvn(sv, hent->h_addr, hent->h_length);
  3319.         }
  3320.         else
  3321.         sv_setpv(sv, (char*)hent->h_name);
  3322.     }
  3323.     RETURN;
  3324.     }
  3325.  
  3326.     if (hent) {
  3327.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3328.     sv_setpv(sv, (char*)hent->h_name);
  3329.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3330.     for (elem = hent->h_aliases; elem && *elem; elem++) {
  3331.         sv_catpv(sv, *elem);
  3332.         if (elem[1])
  3333.         sv_catpvn(sv, " ", 1);
  3334.     }
  3335.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3336.     sv_setiv(sv, (I32)hent->h_addrtype);
  3337.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3338.     len = hent->h_length;
  3339.     sv_setiv(sv, (I32)len);
  3340. #ifdef h_addr
  3341.     for (elem = hent->h_addr_list; elem && *elem; elem++) {
  3342.         XPUSHs(sv = sv_mortalcopy(&sv_no));
  3343.         sv_setpvn(sv, *elem, len);
  3344.     }
  3345. #else
  3346.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3347.     if (hent->h_addr)
  3348.         sv_setpvn(sv, hent->h_addr, len);
  3349. #endif /* h_addr */
  3350.     }
  3351.     RETURN;
  3352. #else
  3353.     DIE(no_sock_func, "gethostent");
  3354. #endif
  3355. }
  3356.  
  3357. PP(pp_gnbyname)
  3358. {
  3359. #if defined(HAS_SOCKET) && !defined(macintosh)
  3360.     return pp_gnetent(ARGS);
  3361. #else
  3362.     DIE(no_sock_func, "getnetbyname");
  3363. #endif
  3364. }
  3365.  
  3366. PP(pp_gnbyaddr)
  3367. {
  3368. #if defined(HAS_SOCKET) && !defined(macintosh)
  3369.     return pp_gnetent(ARGS);
  3370. #else
  3371.     DIE(no_sock_func, "getnetbyaddr");
  3372. #endif
  3373. }
  3374.  
  3375. PP(pp_gnetent)
  3376. {
  3377.     dSP;
  3378. #if defined(HAS_SOCKET) && !defined(macintosh)
  3379.     I32 which = op->op_type;
  3380.     register char **elem;
  3381.     register SV *sv;
  3382.     struct netent *getnetbyname();
  3383.     struct netent *getnetbyaddr();
  3384.     struct netent *getnetent();
  3385.     struct netent *nent;
  3386.  
  3387.     if (which == OP_GNBYNAME)
  3388.     nent = getnetbyname(POPp);
  3389.     else if (which == OP_GNBYADDR) {
  3390.     int addrtype = POPi;
  3391.     unsigned long addr = U_L(POPn);
  3392.     nent = getnetbyaddr((long)addr, addrtype);
  3393.     }
  3394.     else
  3395.     nent = getnetent();
  3396.  
  3397.     EXTEND(SP, 4);
  3398.     if (GIMME != G_ARRAY) {
  3399.     PUSHs(sv = sv_newmortal());
  3400.     if (nent) {
  3401.         if (which == OP_GNBYNAME)
  3402.         sv_setiv(sv, (I32)nent->n_net);
  3403.         else
  3404.         sv_setpv(sv, nent->n_name);
  3405.     }
  3406.     RETURN;
  3407.     }
  3408.  
  3409.     if (nent) {
  3410.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3411.     sv_setpv(sv, nent->n_name);
  3412.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3413.     for (elem = nent->n_aliases; *elem; elem++) {
  3414.         sv_catpv(sv, *elem);
  3415.         if (elem[1])
  3416.         sv_catpvn(sv, " ", 1);
  3417.     }
  3418.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3419.     sv_setiv(sv, (I32)nent->n_addrtype);
  3420.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3421.     sv_setiv(sv, (I32)nent->n_net);
  3422.     }
  3423.  
  3424.     RETURN;
  3425. #else
  3426.     DIE(no_sock_func, "getnetent");
  3427. #endif
  3428. }
  3429.  
  3430. PP(pp_gpbyname)
  3431. {
  3432. #ifdef HAS_SOCKET
  3433.     return pp_gprotoent(ARGS);
  3434. #else
  3435.     DIE(no_sock_func, "getprotobyname");
  3436. #endif
  3437. }
  3438.  
  3439. PP(pp_gpbynumber)
  3440. {
  3441. #ifdef HAS_SOCKET
  3442.     return pp_gprotoent(ARGS);
  3443. #else
  3444.     DIE(no_sock_func, "getprotobynumber");
  3445. #endif
  3446. }
  3447.  
  3448. PP(pp_gprotoent)
  3449. {
  3450.     dSP;
  3451. #ifdef HAS_SOCKET
  3452.     I32 which = op->op_type;
  3453.     register char **elem;
  3454.     register SV *sv;
  3455.     struct protoent *getprotobyname();
  3456.     struct protoent *getprotobynumber();
  3457.     struct protoent *getprotoent();
  3458.     struct protoent *pent;
  3459.  
  3460.     if (which == OP_GPBYNAME)
  3461.     pent = getprotobyname(POPp);
  3462.     else if (which == OP_GPBYNUMBER)
  3463.     pent = getprotobynumber(POPi);
  3464.     else
  3465. #ifdef macintosh
  3466.         DIE(no_sock_func, "getprotoent");
  3467. #else
  3468.     pent = getprotoent();
  3469. #endif
  3470.  
  3471.     EXTEND(SP, 3);
  3472.     if (GIMME != G_ARRAY) {
  3473.     PUSHs(sv = sv_newmortal());
  3474.     if (pent) {
  3475.         if (which == OP_GPBYNAME)
  3476.         sv_setiv(sv, (I32)pent->p_proto);
  3477.         else
  3478.         sv_setpv(sv, pent->p_name);
  3479.     }
  3480.     RETURN;
  3481.     }
  3482.  
  3483.     if (pent) {
  3484.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3485.     sv_setpv(sv, pent->p_name);
  3486.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3487.     for (elem = pent->p_aliases; *elem; elem++) {
  3488.         sv_catpv(sv, *elem);
  3489.         if (elem[1])
  3490.         sv_catpvn(sv, " ", 1);
  3491.     }
  3492.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3493.     sv_setiv(sv, (I32)pent->p_proto);
  3494.     }
  3495.  
  3496.     RETURN;
  3497. #else
  3498.     DIE(no_sock_func, "getprotoent");
  3499. #endif
  3500. }
  3501.  
  3502. PP(pp_gsbyname)
  3503. {
  3504. #ifdef HAS_SOCKET
  3505.     return pp_gservent(ARGS);
  3506. #else
  3507.     DIE(no_sock_func, "getservbyname");
  3508. #endif
  3509. }
  3510.  
  3511. PP(pp_gsbyport)
  3512. {
  3513. #ifdef HAS_SOCKET
  3514.     return pp_gservent(ARGS);
  3515. #else
  3516.     DIE(no_sock_func, "getservbyport");
  3517. #endif
  3518. }
  3519.  
  3520. PP(pp_gservent)
  3521. {
  3522.     dSP;
  3523. #ifdef HAS_SOCKET
  3524.     I32 which = op->op_type;
  3525.     register char **elem;
  3526.     register SV *sv;
  3527.     struct servent *getservbyname();
  3528.     struct servent *getservbynumber();
  3529.     struct servent *getservent();
  3530.     struct servent *sent;
  3531.  
  3532.     if (which == OP_GSBYNAME) {
  3533.     char *proto = POPp;
  3534.     char *name = POPp;
  3535.  
  3536.     if (proto && !*proto)
  3537.         proto = Nullch;
  3538.  
  3539.     sent = getservbyname(name, proto);
  3540.     }
  3541.     else if (which == OP_GSBYPORT) {
  3542.     char *proto = POPp;
  3543.     int port = POPi;
  3544.  
  3545.     sent = getservbyport(port, proto);
  3546.     }
  3547.     else
  3548.     sent = getservent();
  3549.  
  3550.     EXTEND(SP, 4);
  3551.     if (GIMME != G_ARRAY) {
  3552.     PUSHs(sv = sv_newmortal());
  3553.     if (sent) {
  3554.         if (which == OP_GSBYNAME) {
  3555. #ifdef HAS_NTOHS
  3556.         sv_setiv(sv, (I32)ntohs(sent->s_port));
  3557. #else
  3558.         sv_setiv(sv, (I32)(sent->s_port));
  3559. #endif
  3560.         }
  3561.         else
  3562.         sv_setpv(sv, sent->s_name);
  3563.     }
  3564.     RETURN;
  3565.     }
  3566.  
  3567.     if (sent) {
  3568.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3569.     sv_setpv(sv, sent->s_name);
  3570.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3571.     for (elem = sent->s_aliases; *elem; elem++) {
  3572.         sv_catpv(sv, *elem);
  3573.         if (elem[1])
  3574.         sv_catpvn(sv, " ", 1);
  3575.     }
  3576.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3577. #ifdef HAS_NTOHS
  3578.     sv_setiv(sv, (I32)ntohs(sent->s_port));
  3579. #else
  3580.     sv_setiv(sv, (I32)(sent->s_port));
  3581. #endif
  3582.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3583.     sv_setpv(sv, sent->s_proto);
  3584.     }
  3585.  
  3586.     RETURN;
  3587. #else
  3588.     DIE(no_sock_func, "getservent");
  3589. #endif
  3590. }
  3591.  
  3592. PP(pp_shostent)
  3593. {
  3594.     dSP;
  3595. #if defined(HAS_SOCKET) && !defined(macintosh)
  3596.     sethostent(TOPi);
  3597.     RETSETYES;
  3598. #else
  3599.     DIE(no_sock_func, "sethostent");
  3600. #endif
  3601. }
  3602.  
  3603. PP(pp_snetent)
  3604. {
  3605.     dSP;
  3606. #if defined(HAS_SOCKET) && !defined(macintosh)
  3607.     setnetent(TOPi);
  3608.     RETSETYES;
  3609. #else
  3610.     DIE(no_sock_func, "setnetent");
  3611. #endif
  3612. }
  3613.  
  3614. PP(pp_sprotoent)
  3615. {
  3616.     dSP;
  3617. #if defined(HAS_SOCKET) && !defined(macintosh)
  3618.     setprotoent(TOPi);
  3619.     RETSETYES;
  3620. #else
  3621.     DIE(no_sock_func, "setprotoent");
  3622. #endif
  3623. }
  3624.  
  3625. PP(pp_sservent)
  3626. {
  3627.     dSP;
  3628. #if defined(HAS_SOCKET) && !defined(macintosh)
  3629.     setservent(TOPi);
  3630.     RETSETYES;
  3631. #else
  3632.     DIE(no_sock_func, "setservent");
  3633. #endif
  3634. }
  3635.  
  3636. PP(pp_ehostent)
  3637. {
  3638.     dSP;
  3639. #if defined(HAS_SOCKET) && !defined(macintosh)
  3640.     endhostent();
  3641.     EXTEND(sp,1);
  3642.     RETPUSHYES;
  3643. #else
  3644.     DIE(no_sock_func, "endhostent");
  3645. #endif
  3646. }
  3647.  
  3648. PP(pp_enetent)
  3649. {
  3650.     dSP;
  3651. #if defined(HAS_SOCKET) && !defined(macintosh)
  3652.     endnetent();
  3653.     EXTEND(sp,1);
  3654.     RETPUSHYES;
  3655. #else
  3656.     DIE(no_sock_func, "endnetent");
  3657. #endif
  3658. }
  3659.  
  3660. PP(pp_eprotoent)
  3661. {
  3662.     dSP;
  3663. #if defined(HAS_SOCKET) && !defined(macintosh)
  3664.     endprotoent();
  3665.     EXTEND(sp,1);
  3666.     RETPUSHYES;
  3667. #else
  3668.     DIE(no_sock_func, "endprotoent");
  3669. #endif
  3670. }
  3671.  
  3672. PP(pp_eservent)
  3673. {
  3674.     dSP;
  3675. #ifdef HAS_SOCKET
  3676.     endservent();
  3677.     EXTEND(sp,1);
  3678.     RETPUSHYES;
  3679. #else
  3680.     DIE(no_sock_func, "endservent");
  3681. #endif
  3682. }
  3683.  
  3684. PP(pp_gpwnam)
  3685. {
  3686. #ifdef HAS_PASSWD
  3687.     return pp_gpwent(ARGS);
  3688. #else
  3689.     DIE(no_func, "getpwnam");
  3690. #endif
  3691. }
  3692.  
  3693. PP(pp_gpwuid)
  3694. {
  3695. #ifdef HAS_PASSWD
  3696.     return pp_gpwent(ARGS);
  3697. #else
  3698.     DIE(no_func, "getpwuid");
  3699. #endif
  3700. }
  3701.  
  3702. PP(pp_gpwent)
  3703. {
  3704.     dSP;
  3705. #ifdef HAS_PASSWD
  3706.     I32 which = op->op_type;
  3707.     register SV *sv;
  3708.     struct passwd *pwent;
  3709.  
  3710.     if (which == OP_GPWNAM)
  3711.     pwent = getpwnam(POPp);
  3712.     else if (which == OP_GPWUID)
  3713.     pwent = getpwuid(POPi);
  3714.     else
  3715.     pwent = (struct passwd *)getpwent();
  3716.  
  3717.     EXTEND(SP, 10);
  3718.     if (GIMME != G_ARRAY) {
  3719.     PUSHs(sv = sv_newmortal());
  3720.     if (pwent) {
  3721.         if (which == OP_GPWNAM)
  3722.         sv_setiv(sv, (I32)pwent->pw_uid);
  3723.         else
  3724.         sv_setpv(sv, pwent->pw_name);
  3725.     }
  3726.     RETURN;
  3727.     }
  3728.  
  3729.     if (pwent) {
  3730.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3731.     sv_setpv(sv, pwent->pw_name);
  3732.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3733.     sv_setpv(sv, pwent->pw_passwd);
  3734.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3735.     sv_setiv(sv, (I32)pwent->pw_uid);
  3736.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3737.     sv_setiv(sv, (I32)pwent->pw_gid);
  3738.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3739. #ifdef PWCHANGE
  3740.     sv_setiv(sv, (I32)pwent->pw_change);
  3741. #else
  3742. #ifdef PWQUOTA
  3743.     sv_setiv(sv, (I32)pwent->pw_quota);
  3744. #else
  3745. #ifdef PWAGE
  3746.     sv_setpv(sv, pwent->pw_age);
  3747. #endif
  3748. #endif
  3749. #endif
  3750.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3751. #ifdef PWCLASS
  3752.     sv_setpv(sv, pwent->pw_class);
  3753. #else
  3754. #ifdef PWCOMMENT
  3755.     sv_setpv(sv, pwent->pw_comment);
  3756. #endif
  3757. #endif
  3758.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3759.     sv_setpv(sv, pwent->pw_gecos);
  3760.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3761.     sv_setpv(sv, pwent->pw_dir);
  3762.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3763.     sv_setpv(sv, pwent->pw_shell);
  3764. #ifdef PWEXPIRE
  3765.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3766.     sv_setiv(sv, (I32)pwent->pw_expire);
  3767. #endif
  3768.     }
  3769.     RETURN;
  3770. #else
  3771.     DIE(no_func, "getpwent");
  3772. #endif
  3773. }
  3774.  
  3775. PP(pp_spwent)
  3776. {
  3777.     dSP;
  3778. #ifdef HAS_PASSWD
  3779.     setpwent();
  3780.     RETPUSHYES;
  3781. #else
  3782.     DIE(no_func, "setpwent");
  3783. #endif
  3784. }
  3785.  
  3786. PP(pp_epwent)
  3787. {
  3788.     dSP;
  3789. #ifdef HAS_PASSWD
  3790.     endpwent();
  3791.     RETPUSHYES;
  3792. #else
  3793.     DIE(no_func, "endpwent");
  3794. #endif
  3795. }
  3796.  
  3797. PP(pp_ggrnam)
  3798. {
  3799. #ifdef HAS_GROUP
  3800.     return pp_ggrent(ARGS);
  3801. #else
  3802.     DIE(no_func, "getgrnam");
  3803. #endif
  3804. }
  3805.  
  3806. PP(pp_ggrgid)
  3807. {
  3808. #ifdef HAS_GROUP
  3809.     return pp_ggrent(ARGS);
  3810. #else
  3811.     DIE(no_func, "getgrgid");
  3812. #endif
  3813. }
  3814.  
  3815. PP(pp_ggrent)
  3816. {
  3817.     dSP;
  3818. #ifdef HAS_GROUP
  3819.     I32 which = op->op_type;
  3820.     register char **elem;
  3821.     register SV *sv;
  3822.     struct group *grent;
  3823.  
  3824.     if (which == OP_GGRNAM)
  3825.     grent = (struct group *)getgrnam(POPp);
  3826.     else if (which == OP_GGRGID)
  3827.     grent = (struct group *)getgrgid(POPi);
  3828.     else
  3829.     grent = (struct group *)getgrent();
  3830.  
  3831.     EXTEND(SP, 4);
  3832.     if (GIMME != G_ARRAY) {
  3833.     PUSHs(sv = sv_newmortal());
  3834.     if (grent) {
  3835.         if (which == OP_GGRNAM)
  3836.         sv_setiv(sv, (I32)grent->gr_gid);
  3837.         else
  3838.         sv_setpv(sv, grent->gr_name);
  3839.     }
  3840.     RETURN;
  3841.     }
  3842.  
  3843.     if (grent) {
  3844.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3845.     sv_setpv(sv, grent->gr_name);
  3846.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3847.     sv_setpv(sv, grent->gr_passwd);
  3848.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3849.     sv_setiv(sv, (I32)grent->gr_gid);
  3850.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3851.     for (elem = grent->gr_mem; *elem; elem++) {
  3852.         sv_catpv(sv, *elem);
  3853.         if (elem[1])
  3854.         sv_catpvn(sv, " ", 1);
  3855.     }
  3856.     }
  3857.  
  3858.     RETURN;
  3859. #else
  3860.     DIE(no_func, "getgrent");
  3861. #endif
  3862. }
  3863.  
  3864. PP(pp_sgrent)
  3865. {
  3866.     dSP;
  3867. #ifdef HAS_GROUP
  3868.     setgrent();
  3869.     RETPUSHYES;
  3870. #else
  3871.     DIE(no_func, "setgrent");
  3872. #endif
  3873. }
  3874.  
  3875. PP(pp_egrent)
  3876. {
  3877.     dSP;
  3878. #ifdef HAS_GROUP
  3879.     endgrent();
  3880.     RETPUSHYES;
  3881. #else
  3882.     DIE(no_func, "endgrent");
  3883. #endif
  3884. }
  3885.  
  3886. PP(pp_getlogin)
  3887. {
  3888.     dSP; dTARGET;
  3889. #ifdef HAS_GETLOGIN
  3890.     char *tmps;
  3891.     EXTEND(SP, 1);
  3892.     if (!(tmps = getlogin()))
  3893.     RETPUSHUNDEF;
  3894.     PUSHp(tmps, strlen(tmps));
  3895.     RETURN;
  3896. #else
  3897.     DIE(no_func, "getlogin");
  3898. #endif
  3899. }
  3900.  
  3901. /* Miscellaneous. */
  3902.  
  3903. PP(pp_syscall)
  3904. {
  3905. #ifdef HAS_SYSCALL
  3906.     dSP; dMARK; dORIGMARK; dTARGET;
  3907.     register I32 items = SP - MARK;
  3908.     unsigned long a[20];
  3909.     register I32 i = 0;
  3910.     I32 retval = -1;
  3911.     MAGIC *mg;
  3912.  
  3913.     if (tainting) {
  3914.     while (++MARK <= SP) {
  3915.         if (SvGMAGICAL(*MARK) && SvSMAGICAL(*MARK) &&
  3916.           (mg = mg_find(*MARK, 't')) && mg->mg_len & 1)
  3917.         tainted = TRUE;
  3918.     }
  3919.     MARK = ORIGMARK;
  3920.     TAINT_PROPER("syscall");
  3921.     }
  3922.  
  3923.     /* This probably won't work on machines where sizeof(long) != sizeof(int)
  3924.      * or where sizeof(long) != sizeof(char*).  But such machines will
  3925.      * not likely have syscall implemented either, so who cares?
  3926.      */
  3927.     while (++MARK <= SP) {
  3928.     if (SvNIOK(*MARK) || !i)
  3929.         a[i++] = SvIV(*MARK);
  3930.     else if (*MARK == &sv_undef)
  3931.         a[i++] = 0;
  3932.     else 
  3933.         a[i++] = (unsigned long)SvPV_force(*MARK, na);
  3934.     if (i > 15)
  3935.         break;
  3936.     }
  3937.     switch (items) {
  3938.     default:
  3939.     DIE("Too many args to syscall");
  3940.     case 0:
  3941.     DIE("Too few args to syscall");
  3942.     case 1:
  3943.     retval = syscall(a[0]);
  3944.     break;
  3945.     case 2:
  3946.     retval = syscall(a[0],a[1]);
  3947.     break;
  3948.     case 3:
  3949.     retval = syscall(a[0],a[1],a[2]);
  3950.     break;
  3951.     case 4:
  3952.     retval = syscall(a[0],a[1],a[2],a[3]);
  3953.     break;
  3954.     case 5:
  3955.     retval = syscall(a[0],a[1],a[2],a[3],a[4]);
  3956.     break;
  3957.     case 6:
  3958.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]);
  3959.     break;
  3960.     case 7:
  3961.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);
  3962.     break;
  3963.     case 8:
  3964.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
  3965.     break;
  3966. #ifdef atarist
  3967.     case 9:
  3968.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
  3969.     break;
  3970.     case 10:
  3971.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
  3972.     break;
  3973.     case 11:
  3974.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3975.       a[10]);
  3976.     break;
  3977.     case 12:
  3978.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3979.       a[10],a[11]);
  3980.     break;
  3981.     case 13:
  3982.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3983.       a[10],a[11],a[12]);
  3984.     break;
  3985.     case 14:
  3986.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3987.       a[10],a[11],a[12],a[13]);
  3988.     break;
  3989. #endif /* atarist */
  3990.     }
  3991.     SP = ORIGMARK;
  3992.     PUSHi(retval);
  3993.     RETURN;
  3994. #else
  3995.     DIE(no_func, "syscall");
  3996. #endif
  3997. }
  3998.  
  3999. #if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
  4000.  
  4001. /*  XXX Emulate flock() with lockf().  This is just to increase
  4002.     portability of scripts.  The calls are not completely
  4003.     interchangeable.  What's really needed is a good file
  4004.     locking module.
  4005. */
  4006.  
  4007. /*  We might need <unistd.h> because it sometimes defines the lockf()
  4008.     constants.  Unfortunately, <unistd.h> causes troubles on some mixed
  4009.     (BSD/POSIX) systems, such as SunOS 4.1.3.  We could just try including
  4010.     <unistd.h> here in this part of the file, but that might
  4011.     conflict with various other #defines and includes above, such as
  4012.     #define vfork fork above.
  4013.  
  4014.    Further, the lockf() constants aren't POSIX, so they might not be
  4015.    visible if we're compiling with _POSIX_SOURCE defined.  Thus, we'll
  4016.    just stick in the SVID values and be done with it.  Sigh.
  4017. */
  4018.  
  4019. # ifndef F_ULOCK
  4020. #  define F_ULOCK    0    /* Unlock a previously locked region */
  4021. # endif
  4022. # ifndef F_LOCK
  4023. #  define F_LOCK    1    /* Lock a region for exclusive use */
  4024. # endif
  4025. # ifndef F_TLOCK
  4026. #  define F_TLOCK    2    /* Test and lock a region for exclusive use */
  4027. # endif
  4028. # ifndef F_TEST
  4029. #  define F_TEST    3    /* Test a region for other processes locks */
  4030. # endif
  4031.  
  4032. /* These are the flock() constants.  Since this sytems doesn't have
  4033.    flock(), the values of the constants are probably not available.
  4034. */
  4035. # ifndef LOCK_SH
  4036. #  define LOCK_SH 1
  4037. # endif
  4038. # ifndef LOCK_EX
  4039. #  define LOCK_EX 2
  4040. # endif
  4041. # ifndef LOCK_NB
  4042. #  define LOCK_NB 4
  4043. # endif
  4044. # ifndef LOCK_UN
  4045. #  define LOCK_UN 8
  4046. # endif
  4047.  
  4048. int
  4049. lockf_emulate_flock (fd, operation)
  4050. int fd;
  4051. int operation;
  4052. {
  4053.     int i;
  4054.     switch (operation) {
  4055.  
  4056.     /* LOCK_SH - get a shared lock */
  4057.     case LOCK_SH:
  4058.     /* LOCK_EX - get an exclusive lock */
  4059.     case LOCK_EX:
  4060.         i = lockf (fd, F_LOCK, 0);
  4061.         break;
  4062.  
  4063.     /* LOCK_SH|LOCK_NB - get a non-blocking shared lock */
  4064.     case LOCK_SH|LOCK_NB:
  4065.     /* LOCK_EX|LOCK_NB - get a non-blocking exclusive lock */
  4066.     case LOCK_EX|LOCK_NB:
  4067.         i = lockf (fd, F_TLOCK, 0);
  4068.         if (i == -1)
  4069.         if ((errno == EAGAIN) || (errno == EACCES))
  4070.             errno = EWOULDBLOCK;
  4071.         break;
  4072.  
  4073.     /* LOCK_UN - unlock */
  4074.     case LOCK_UN:
  4075.         i = lockf (fd, F_ULOCK, 0);
  4076.         break;
  4077.  
  4078.     /* Default - can't decipher operation */
  4079.     default:
  4080.         i = -1;
  4081.         errno = EINVAL;
  4082.         break;
  4083.     }
  4084.     return (i);
  4085. }
  4086. #endif
  4087.